"19:45:24, 19 April 2003: Compressing sources...."!
Object comment:
'Object is the abstract root of the standard Smalltalk class hierarchy. It has no instance variables (indeed it must not have any), but provides behavior common to all objects.
Instance Variables:
<MUST BE NONE>
Class Variables:
_AssertionFailureSignal <Signal> raised when assertion failures occur (see #assert:)
_DependentsRegister <WeakIdentityDictionary> containing DependentsCollections for instances
_EventsRegister <WeakIdentityDictionary> containing EventsCollections for instances
_FinalizeMask <Integer> bit mask to set/reset the finalize mark of instances
The following Instance specific behaviour mask constants are held in the PoolConstantsDictionary _InstanceBehaviorMasks in order that they may be readily shared into user defined root classes.
_GetSpecialMask <Integer> bit mask to retrieve special behavior flags of instances
_PropertyRegister <PropertyManager> Register of instance specific information not stored in instance variables
_WeakMask <Integer> bit mask to use to set/reset the weak mark of instances
Note: All class variables beginning with $_ are private to the implementation. This convention is adopted to avoid potential name clashes with user defined classes.
Object implements the ANSI protocol <Object> (browse the protocols-Object category).
The following messages defined in Object have optimized implementations inlined by the Compiler and cannot be overridden:
#==
#basicAt: (overridable if subclass not indexable)
#basicAt:put: (ditto)
#basicSize
#basicClass
#isNil
#notNil
In addition any selector in Object with a ''basic'' prefix may be subject to inlining in future releases, so these should not be overridden.
'!
!Object class methodsFor!
_eventsRegister
"Private - Answer the register of events"
^_EventsRegister!
binaryReadFrom: aStream
"Answers an object read from its binary representation on aStream.
This must have been saved using Object>>binaryStoreOn:"
^self binaryReadFrom: aStream context: nil
!
binaryReadFrom: aStream context: anObject
"Answers an object read from its binary representation on aStream.
This must have been saved using Object>>binaryStoreOn:"
^(STBInFiler on: aStream) context: anObject; next.!
fromBinaryStoreBytes: aByteArray
"Answers an object read from its binary representation in aByteArray.
This must have been created using Object>>binaryStoreBytes"
when: anEventSymbol send: aSelector to: anObject with: anArgument
"Register an event handler such that when the receiver triggers the event
anEventSymbol, the keyword selector, aSelector, is sent to anObject with the
single argument, anArgument."
self when: anEventSymbol
perform: (EventMessageSend
receiver: anObject
selector: aSelector
argument: anArgument)!
when: anEventSymbol send: aSelector to: anObject withArguments: anArray
"Register an event handler such that when the receiver triggers the event
anEventSymbol, the multi-keyword selector aSelector is sent to anObject with arguments
from anArray."
self when: anEventSymbol
perform: (EventMessageSend
receiver: anObject
selector: aSelector
arguments: anArray)!
when: anEventSymbol sendTo: anObject
"Register an event handler such that when the receiver triggers the event
anEventSymbol, it is sent as a unary selector to anObject."
self
when: anEventSymbol
send: anEventSymbol
to: anObject!
yourAddress
"Answer the address of the body of the receiver. The primitive does not fail.
The answer (an Integer) can be passed to external procedures as a pointer
or stored into another byte object representing a structure as a member pointer,
and call also be mutated (using #becomeA(n):) into a byte object such as ExternalAddress.
Although the primitive does not fail for non-byte objects, it is potentially unsafe
to access these indirectly, almost certainly an error to pass their address to
external procedures, and very likely to cause unexpected behaviour if used to modify
the contents of the object.
When taking the address of an object, you are entering the unprotected realms
of pointer manipulation, and need to be aware of object lifetime issues. In particular
be careful not to pass the address of a temporary object to a third party which is
intending to keep hold of that address, as the address will become invalid if the
object is garbage collected. In addition, if the third party writes off the front or end
of the object, it may corrupt the Smalltalk image, and cause unexpected behavior.
It is often better to use an external buffer, outside the Smalltalk object space, and
manage its lifetime yourself."
<primitive: 103>
^self primitiveFailed!
yourself
"Answer the receiver (useful for returning the receiver from a cascaded message)."
^self
! !
ProtoObject comment:
'ProtoObject is an abstract class that can be used as a basis for creating a variety of "stub" subclasses. It supplies the minimum protocol that might be useful for any such stub in order that inspection and debugging may successfully take place.'!
!ProtoObject class methodsFor!
publishedAspects
"Answer a <LookupTable> of the <Aspect>s published by the receiver.
Overridden by subclasses to add the aspects published locally"
'This class forms part of a tutorial for the Dolphin Beginner''s Guide. An Animal represents a potential guess in the animal guessing game. Animal instances are always the leaf nodes in the game''s knowledge tree which is held in the class variable, KnowledgeBase. The main part of the tree is built from instances of Question.
The game can be played by a evaluating:
Animal playGame.
The knowledge base is initially set up in Animal>>initialize to only know about a single animal; a dog. This method can be re-executed at any point to reset the knowledge tree to its starting point:
"Private - Initialize the name of the receiver to aString"
name := aStringName!
printOn: aStream
"Answer the name of the receiver as a developer would wish to see it ."
super printOn: aStream.
aStream nextPut: $(.
self displayOn: aStream.
aStream nextPut: $).! !
AttributeDescriptor comment:
'AttributeDescriptor is an abstract class of meta-objects that be used to describe the shape of other objects. It has a subclass, Aspect, instances of which describe how to access object''s published ''aspects'' (e.g. instance variables) through getter and setter methods, and a subclass, ExternalField, instances of which describe the fields of C style structures. Note that these objects are all descriptors, and need to be combined with a subject object in order to become "closed".'!
!AttributeDescriptor class methodsFor!
inaccessible
"Private - Answer an instance of the receiver which describes an attribute
which is neither writable nor readable."
^self new beInaccessible
!
initialize
"Private - Initialize class variables of the receiver.
AttributeDescriptor initialize
"
ReadableMask := 16r1.
WriteableMask := 16r2.
AccessorMask := 16r4.
MutatorMask := 16r8.
OverrideMask := 16r10.
MutableMask := 16r20.
NullableMask := 16r40!
new
"Answer an instance of the receiver which describes an attribute
which can be both read from and written to."
^super new initialize!
readOnly
"Answer an instance of the receiver which describes an attribute
which cannot be set."
^self new beReadOnly!
uncompiled
"Answer an instance of the receiver which describes a field which will not be compiled."
^self new beUncompiled!
writeOnly
"Answer an instance of the receiver which describes an attribute
which cannot be read, only written."
^self new beWriteOnly! !
!AttributeDescriptor methodsFor!
beCompiled
"Set the receiver's flags to specify it as an compiled attribute
(i.e. one with compiled accessors to retrieve/set its value).
'AXTypeInfoAnalyzer is a class which wraps an Active-X Automation <ITypeInfo> interface pointer and adds higher level behaviours for analyzing the type information available through that interface.
ITypeInfo itself contains a large number of member functions which allow one to enquire about the structure and attributes of each of the individual elements of a Type Library. Unfortunately it is rather poorly factored in that a single interface is used to describe widely differing objects. We have therefore applied the "Conditional Elimination" refactoring pattern and created a pseudo hierarchy as follows:
- TYPEKIND_ENUM TKindEnumAnalyzer an enumerated type
- TYPEKIND_RECORD TKindRecordAnalyzer a C-style struct
- TYPEKIND_MODULE TKindModule a shared library/DLL of static functions and constants
- TYPEKIND_INTERFACE TKindInterfaceAnalyzer a custom COM interface
- TYPEKIND_DISPATCH TKindDispatchAnalyzer an Active-X Automation interface
- TYPEKIND_COCLASS TKindCoclassAnalyzer an instantiable component class with a CLSID
- TYPEKIND_ALIAS TKindAliasAnalyzer a C-style typedef which defines a name for a type
- TYPEKIND_UNION TKindUnionAnalyzer a C-style union (struct with overlapping members)
Each subclass contains specific behaviours appropriate for querying relevant information for its particular type kind, and also for generating Smalltalk wrappers for that type.
Instance Variables:
piTypeInfo <ITypeInfo>. Interface onto type library information relevant to this type element.
typeLib <AXTypeLibraryAnalyzer>. Owning type library.
globalBinding <Association>. The global binding being generated, usually a Class.
generationFlags <integer>. Flags controlling the generation process.
▓¼Å!!▀π▌ß╚≈┘╪╕╘¢τcQ╢¡┴ovÆ░6W╫MA)kREn ▒Æ^^j)Mópc▒δ!!÷╠G¼«≈Äσ╩Ö`@mh▀┐fr║╞ÇTI₧╙`╝F÷täA⌠P\I,Θa▀═XæG4┐,╓Ç└·═│`σg÷Ü¥xOº≈J¡tJzæΣs╩╫ZºT<╔MÜⁿ?!!·╚v─K|═>Ñ╒îJ4ºª∙Ωá╝┤iO∙╧ÖJjZ c ÖΩ51FDçW∞ Ö╢\|TD▀ò'ÄHBé æ¿≡n±╜ëá≡W┤δ╠╦E8R«s± ` Σ╛{ÇlΓë┴¥Å╥M╒ö¿î/₧{≥xΣ?├º√╨@f] Z ■ûµ8lâ1¢~═UM`ëls╫╗7Ω!!U╞Ѫ\P#pq─@₧Θ╩A
'AXTypeLibraryAnalyzer is a wrapper class around <ITypeLib> which adds higher level wrapper functions which make ITypeLib easier to use. It is also the starting point for Dolphin''s automatic generation of wrapper classes &c for Active-X objects described by type libraries.
A Type Library is a repository of meta-information, typically about Active-X (COM, OLE, choose your favourite name) objects and interfaces. AXTypeLibraryAnalyzer permits one to enquire about general attributes of a Type Library, but more importantly it enables one to enumerate through the individual meta-elements by acquiring <AXTypeInfoAnalyzer> objects which describe them. For example it is easy to acquire all of the meta-information of a particular type from the library by sending one of the following selectors:
#interfaces
#dispinterfaces
#coclasses
#enums
#unions
#structs
#modules
#typedefs
AXTypeLibraryAnalyzer is primarily intended as part of Dolphin''s development environment, but it also has run time uses when Dolphin is implementing dispinterfaces (for example).
AXTypeLibraryAnalyzer can also reverse engineer the IDL for a type library in the same manner as Microsoft''s OLEVIEW.EXE (except that it is does a more accurate job and is nearly twice as fast as the latter). For example:
at: (self position - (self icon extent / 2)) truncated!
icon
^icon isNil ifTrue: [self class icon] ifFalse: [icon]!
icon: anObject
icon := anObject!
position
^position!
position: anObject
position := anObject!
velocity
^velocity!
velocity: anObject
velocity := anObject! !
Behavior comment:
'Class Behavior is the abstract class which defines the minimum state necessary for objects that have instances, providing the basic information about those instances to the Compiler and the VM.
Instance Variables:
superclass <Behavior> object of the instance''''s superclass
subclasses <Array> of Behavior''s which are the subclasses of the instance
methodDictionary <MethodDictionary> mapping selector Symbols to CompiledMethods
instanceSpec <integer> containg flags which describe the "shape" of the instance (e.g. oops vs bytes)
Behavior defines a number of bit masks which are used to describe objects. These flags are stored in the pool dictionary,
_BehaviorMasks, for ease of sharing with the ClassBuilder and other tools::
_BasicSpecMask <integer> bit mask to extract the basic inst. spec (excludes extra spec word).
_BytesSubMask <integer> bit mask to extract inst. spec. bits relating exclusively to byte objects
_FundamentalShapeMask <integer> bit mask to extract the fundamental shape of instances from instance spec.
_IndirectMask <integer> bit mask to extract indirection (i.e. memory pointer) flag from inst. spec. flags
The indirection bit marks classes whose instances are indirect references to
other objects/memory - e.g. ExternalAddresses. Such objects are automatically
dereferenced when passed to appropriate VM primitives.
_MournerMask <integer> bit mask to extract mourner flag from inst. spec. flags
The mourner bit marks classes who actively grieve for the loss of their constituents.
Weak instances of such classes will be notified by the Undertaker process when
they suffer bereavements during a GC. This notification is ''''off'''' by default because the
receipt of such a notifications will delay the death of its receiver, which may result in
significantly extended life for hierarchies of incestuously referencing weak objects.
_NullTermMask <integer> bit mask to extract null terminated flag from inst. spec. (byte objects only)
The null term. bit can be used to mark byte classes as having an implicit null terminator
(e.g. to represent C-style strings).
_PointersMask <integer> bit mask to extract the pointers/bytes flag from inst. spec.
The pointer bit marks classes whose instances contain pointers (as opposed to bytes).
_ShapeMask <integer> bit mask to extract the shape flags from inst. spec.
_SizeMask <Integer> bit mask to extract the number of named inst. vars. from inst. spec.
The size bits specify the number of named instance variables (0..255) in instances
of the receiver.
_VariableMask <integer> bit mask to extract the fixed/variable size flag from inst. spec.
The variable bit marks classes whose instances include indexable (unnamed)
instance variables.
Behavior implements the ANSI protocols <Object>, <classDescription>, <instantiator>, and <Object class>.'!
!Behavior class methodsFor!
icon
"Answers an Icon that can be used to represent this class."
^Class icon! !
!Behavior methodsFor!
addSelector: aSymbol withMethod: aCompiledMethod
"Private - Add the message selector, aSymbol, with the corresponding
CompiledMethod, to the receiver's method dictionary.
Implementation Note: Clears down the VM method cache in case a previous
version of the method is cached, or it overrides a superclass method."
"Answer a new, suspended, Process which will evaluate the receiver, and terminate
when and if the code in the receiver returns. The default 'name' given to the process
is the originating CompiledMethod - this is useful for debugging because it
allows one to locate the source (e.g. Process name getSource) to determine
what the process is doing."
^(Process forContext: [
self on: ProcessTermination do: [:e | e return].
"^-return catches attempt to drop off bottom of process stack (which would cause a GPF)"
^Processor activeProcess shutdown]
priority: Processor activePriority)
name: self method;
yourself
!
newProcessWithArguments: anArray
"Answer a new process which will evaluate the receiver with arguments
from anArray, then terminate"
^[self valueWithArguments: anArray] newProcess!
on: selector do: action
"Try to evaluate the receiver, and should an exception occur which is matched
by the <exceptionSelector>, selector, normally a class object which is a subclass
of Exception), evaluate the <monadicBlock>, action, passing it the exception
instance as its argument."
^(ExceptionHandler on: selector do: action) try: self!
on: selector1 do: action1 on: selector2 do: action2
"Try to evaluate the receiver, and should an exception occur which is matched
by any of the <exceptionSelector>s, selector1..selector2, then evaluate the
corresponding <monadicBlock>, actionN, passing it the exception instance as
its argument."
^self onDo: ((ExceptionHandlerSet new)
on: selector1 do: action1;
on: selector2 do: action2)!
on: selector1 do: action1 on: selector2 do: action2 on: selector3 do: action3
"Try to evaluate the receiver, and should an exception occur which is matched
by any of the <exceptionSelector>s, selector1..selector3, then evaluate the
corresponding <monadicBlock>, actionN, passing it the exception instance as
its argument."
^self onDo: ((ExceptionHandlerSet new)
on: selector1 do: action1;
on: selector2 do: action2;
on: selector3 do: action3)!
on: selector1 do: action1 on: selector2 do: action2 on: selector3 do: action3 on: selector4 do: action4
"Try to evaluate the receiver, and should an exception occur which is matched
by any of the <exceptionSelector>s, selector1..selector4, then evaluate the
corresponding <monadicBlock>, actionN, passing it the exception instance as
its argument."
^self onDo: ((ExceptionHandlerSet new)
on: selector1 do: action1;
on: selector2 do: action2;
on: selector3 do: action3;
on: selector4 do: action4)!
on: selector1 do: action1 on: selector2 do: action2 on: selector3 do: action3 on: selector4 do: action4 on: selector5 do: action5
"Try to evaluate the receiver, and should an exception occur which is matched
by any of the <exceptionSelector>s, selector1..selector5, then evaluate the
corresponding <monadicBlock>, actionN, passing it the exception instance as
its argument."
^self onDo: ((ExceptionHandlerSet new)
on: selector1 do: action1;
on: selector2 do: action2;
on: selector3 do: action3;
on: selector4 do: action4;
on: selector5 do: action5)!
on: selector1 do: action1 on: selector2 do: action2 on: selector3 do: action3 on: selector4 do: action4 on: selector5 do: action5 on: selector6 do: action6
"Try to evaluate the receiver, and should an exception occur which is matched
by any of the <exceptionSelector>s, selector1..selector6, then evaluate the
corresponding <monadicBlock>, actionN, passing it the exception instance as
its argument."
^self onDo: ((ExceptionHandlerSet new)
on: selector1 do: action1;
on: selector2 do: action2;
on: selector3 do: action3;
on: selector4 do: action4;
on: selector5 do: action5;
on: selector6 do: action6)!
onDo: exceptionHandler
"Try to evaluate the receiver under the protection of the <ExceptionHandler>
argument, exceptionHandler."
^exceptionHandler try: self!
outer
"Private - Answer the receiver's outer context."
^outer!
outer: anObject
"Private - Set the outer context of the receiver to anObject (a MethodContext or nil).
'Boolean is the class which provides the protocol for logical values. The actual logical values, true and false, are represented by Boolean''s subclasses True and False. Boolean itself is abstract.
In Smalltalk many control structures, such as conditional evaluations, are implemented by sending messages to Booleans, rather than by incorporating control flow mechanisms into the syntax of the language. The compiler does, however, inline certain commonly used messages such as #ifTrue:ifFalse: for reasons of performance. For this reason some methods of Boolean are not normally executed unless #perform:''d.
Booleans implement the ANSI protocols <Object> (by inheritance) and <boolean>.'!
!Boolean class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"It is not necessary to instantiate Booleans - use the literals 'true'
and 'false'."
^self shouldNotImplement!
newAspect: aspectClass name: aSymbol
"Private - Answer a new <Aspect> of the class, aspectClass, and with name, aSymbol,
which is appropriate for representing aspects of the receiver's type."
^aspectClass boolean: aSymbol!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect boolean: #yourself);
yourself! !
!Boolean methodsFor!
& operand
"Answer whether the receiver and the <boolean> argument, operand,
are both true. Note that this is the evaluating conjunction, use #and: instead for
non-evaluating expressions.
Implementation Note: The #ifTrue:ifFalse: is present in order to have the
VM check that the operand is actually a <Boolean>. The compiler will
actually optimize a lot of this away and generate quite efficient code (try
Ctrl+I to inspect the method and view the disassembly listing)."
"Answers a Point that is the ratio of window units to device units for the receiver"
^self windowExtent / self viewportExtent! !
Category comment:
'The abstract Category class is used to organize <Class> and <CompiledMethod> objects into subgroupings independent of the implementation hierarchy. This structuring is for the benefit of the user navigating through thousands of classes and methods in the Dolphin Smalltalk development system, and has no run-time significance.
Instance Variables:
name <String> name of the receiver, unique in the system.
comment <String> description of the category, for documentary purposes.
Class Variables:
PermanentCategories <Set> of all categories which are always available, even if empty
'!
!Category class methodsFor!
categoryIcon
"Answer an Icon representing the Category objects which the receiver collects."
^self icon!
initialize
"Private - Initialize the receiver's class variables."
PermanentCategories := IdentitySet new!
name: categoryName
"Answer the subinstance of the receiver with the
<readableString> name, categoryName."
^self subclassResponsibility!
new
"Categories must be unique for any particular name, and must be instantiated with the #name:
method."
^self shouldNotImplement!
newNamed: categoryName
"Private - Answer a new subinstance of the receiver with the
<readableString> name, categoryName."
^self basicNew
setName: categoryName asString;
yourself!
separator
"Private - Answer a Character used to split the individual names in a
complete category."
^ $-!
unclassified
"Answer a Category used to mark an unclassified object."
^self name: self unclassifiedName!
unclassifiedName
"Private - Answer the String name used to mark a none existing category."
^self subclassResponsibility!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
PermanentCategories := nil.! !
!Category methodsFor!
<= comperand
"Answer whether the receiver is less than or equal to the <Category>,
comperand."
^self name <= comperand name!
= comperand
"Answer whether the receiver is considered equal to the <Object>, comperand."
^self species == comperand species and: [self name equals: comperand name]!
acceptsAdditions
"Answer whether new members can be added to the receiver.
Generally speaking pseudo categories do not accept additions, and
ordinary categories do. Some types of non-pseudo virtual categories
can have methods added to them."
^self isPseud not!
addClass: class
"Add the <Class>, class, to the collection of classes associated with the receiver."
^self subclassResponsibility!
asString
"Answer the string representation for the receiver."
^self name!
categoryIcon
"Answer an Icon representing the Category object which the receiver matches."
^self class categoryIcon!
contents
"Answer all the objects held by the receiver."
^self subclassResponsibility!
displayOn: aStream
"Append the receiver to aStream in a format that a user would want to see"
aStream nextPutAll: self name!
hash
"Answer the <integer> hash value for the receiver."
^self name hash!
isIntermediate
"Private - Answer whether the receiver is a temporary category used only as a
branch node in a category tree."
^false!
isPermanent
"Answer whether the receiver should be not removed from a CategoryManager
when there are no references to it."
^PermanentCategories includes: self!
isPermanent: aBoolean
"Set whether the receiver should not be removed when there are
"Answer a new color which is a faded (half intensity) copy of the receiver."
^self fadedBy: 2!
fadedBy: aNumber
"Answer a new <Color> which is a copy of the receiver faded by
the specified factor."
| rgb |
rgb := self asRGB.
^Color
red: 255 - ((255 - rgb red) // aNumber)
green: 255 - ((255 - rgb green) // aNumber)
blue: 255 - ((255 - rgb blue) // aNumber)!
pen
"Answer a Pen configured for solid painting of the receiver's color."
^self penClass color: self!
penClass
"Private - Answer the class of Pen to be used in conjunction with the receiver."
^Pen! !
COMFunctionAbstract comment:
'COMFunctionAbstract is the class of objects which describe COM functions or methods. A COMFunctionAbstract is a meta-level description that holds the type of the functions arguments, the selector of the implementation of this function. COMFunctionAbstract itself is abstract, with subclasses defined to describe different types of function.
An important behaviour of COMFunctionAbstract is the forwarding of an incoming COM method call to the Smalltalk implementation of that method. Different types of COMFunctionAbstract may forward such calls to different objects, perhaps as different messages. Each <COMInterface> class maintains an <Array> of COMFunctionAbstract subinstances, one for each of the functions defined for the interface, in virtual function table order. When a callback to a COM object implemented in Dolphin arrives from the VM (via the Processor object), the callback gets resolved to the corresponding <COMFunctionXXXX> which is then asked to send an appropriate message to the implementor of that function. The <COMFunctionXXXX> uses argument type information to marshal the arguments from the machine stack into appropriate Smalltalk objects, and then forwards the message as defined by its selector. The implementor might be the generic stub <COMObjectStub> - of which there is an instance for every COM object served up by Dolphin - if the function call is to one of the IUnknown methods, or the <Object> which served up the interface in the first place. The architecture allows the implementor to vary on a per function basis.'!
!COMFunctionAbstract methodsFor!
argumentCount
"Private - Answer the number of arguments expected by the receiver when
evaluated."
^self descriptor argumentCount!
argumentsSize
"Private - Answer the total size of the receiver's arguments (when
pushed on the stack."
^self descriptor argumentsSize!
argumentTypes
"Private - Answer a collection of the argument type names used to instantiate arguments as
Smalltalk objects when the receiver is evaluated."
"Private - Forward a COM virtual function call as a message to the appropriate implementing
object stored in the interface, aCOMInterface, with arguments instantiated from memory pointed
at by anAddress, corresponding to the receivers argument types. Answer the result.
Implementation Note: This is the normal form of COM dispatch."
^stub implementor "Forward to the COM server object"
perform: self selector
withArgumentsAt: anAddress
descriptor: self descriptor
!
callingConvention
"Private - Answer the calling convention of the receiver's function."
^self descriptor callingConvention!
descriptor
"Private - Answer the descriptor object which described the external function represented
by the receiver."
^self subclassResponsibility!
messageSelectorAndArgumentNames
"Private - Answer the text to be used for the message selector and argument names
for automatically generated implementations of the function described by the receiver."
| aStream keywords |
aStream := (String new: 256) writeStream.
self argumentCount > 0
ifTrue: [
keywords := self selector keywords.
keywords do: [:s |
aStream
nextPutAll: s; space;
nextPut: s first asLowercase;
next: s size - 2 putAll: s startingAt: 2]
separatedBy: [aStream space]]
ifFalse: [aStream nextPutAll: self selector].
^aStream contents!
printOn: aStream
"Append debug info about the receiver to aStream."
aStream
basicPrint: self;
nextPut: $(;
print: self selector;
space;
print: self descriptor description;
nextPut: $)!
returnType
"Private - Answer the return type name of the receiver."
^self descriptor returnType!
selector
"Private - Answer the selector sent when the receiver is evaluated."
^self subclassResponsibility! !
COMInterfaceImp comment:
'COMInterfaceImp is an abstract class which provides the basic implementation for a COM object such as interface querying (i.e. implements #queryInterface:ifNone: sent by the framework when a previously unencountered interface is requested of the COM object), factory registration, CLSID access, and aggregation.
Note that, although it is convenient, it is not necessary for a COM server object to be a subclass of this class: any Dolphin object can be a COM object. The COM framework provides a wrapper class, COMObjectStub, which takes care of the boilerplate implementation details, and hence the responsibilities here are few and simple. The only message sent by framework to a COM server object is #queryInterface:ifNone:, and even that is optional. If your class sits more happily elsewhere in the hierarchy then this class is a suitable reference for implementing COM support directly in your class.
Subclasses should implement:
(class)#clsid to answer their CLSID
(class)#progID to answer their ProgID (necessary for registration)
#supportedInterfaces to answer an Array of the support interface classes (not class names)
Subclasses may implement:
#aggregatee to answer an aggregated object, if supported
Having added your subclass (and implemented #clsid), you can expose your object to external clients by sending the class the #registerClassFactory method. This need only be done once and a class factory will then be registered with COM each time the image is started. #revokeClassFactories permanently undoes the registration.
Should you wish to aggregate another object in your subclass then see the comment in the #aggregatee instance method for further instructions.'!
!COMInterfaceImp class methodsFor!
clsid
"Answer the CLSID which identifies the receiver's server class in the registry.
Valid subclasses can be created which do not implement this method, but they will
be noncreatable COM coclasses (i.e they cannot be instantiated with CoCreateInstance())."
^CLSID null!
inprocSurrogate: aBoolean
"Answer the COM server DLL which can be used as a surrogate to host the development
image. This can be used for debugging an in-process component, or bound with a stripped image
"Answer the server object on behalf of which the receiver is implementing an
interface or interfaces. By default this is the receiver itself, but subclasses
may implement interfaces on behalf of other objects in order that any particular
server object can support any number of interfaces with different implementors."
^self!
supportedInterfaces
"Answer the set of interface classes supported by the receiver.
N.B. The receiver should implement all of the methods defined in all of the
interfaces in the collection answered, with the same selector names (i.e. the
first keyword will be the COM function name, with an uppercase initial letter).
A simple way to generate templates for these methods is to use the <MethodProtocol>
mechanism. The type library analyzer can be configured to generate a protocol when
it is building an interface wrapper class. The protocol can simply be dragged into
the implementation class to generate the required set of methods. These template
methods do nothing but return E_NOTIMPL and can be implemented
as necessary."
^self subclassResponsibility! !
Command comment:
'A Command is used to perform a user interface command as part of the MVP framework. It is effectively a <CommandDescription> that is bound to a particular receiver and its operation can be performed by sending it a #value message.
Command objects come with the additional capablity of being able to optionally undo and redo the command''s action. We assume that the target responsible for executing the command will also have sufficient information to specify how the command should be undone all re-done. The target may get hold of the currently executing command using:
Command current.
An undo operation may be specified using #undoWith: supplying a <nildadicValuable> as its parameter. This valuable is evaluated when #undo is requested. It is important to understand that a redo operation, if required, cannot just be performed by re-executing a Command using #value. This is because many command operations depend on the state of the target that exists when the command is executed (e.g. current selections etc.) and this state may certainly have changed by the time the redo is required. Consequently, if redo support is required, it is necessary for the target to specify exactly how this should be achieved using Command>>#undoWith: and supplying an appropriate <niladicValuable> that, when evaluated, will go ahead and perform the redo.
If undo/redo support has been enabled for a particular <topPresenter> by enabling its command history using #hasCommandHistory:, then the command framework will expect an undo action to be supplied for every command that can be undone. If such an action is not supplied then we assume that all previous undo history has been invalidated and the command history list will be cleared. However, some commands don''t actually change the state of their targets and so can''t be undone. At the same time they don''t invalidate the previous undo history either. For such commands it is necessary to indicate this behaviour to the framework using Command>>beBenign. When the framework sees that a command has been marked as benign, it does not add it to the current Shell''s command history nor does it clear it.
Instance Variables:
commandDescription <CommandDescription> specifying the command to be performed.
receiver <Object> to which the command will be directed.
undoAction <niladicValuable> that, when evaluated, will undo the original command.
redoAction <niladicValuable> that, when evaluated, will redo the original command.
isBenign <boolean> indicating that a command has had no effect on the receiver''s state.'!
!Command class methodsFor!
current
"Answers the current instance of the receiver that is being performed"
'A CommandDescription acts as the fundamental source for all MVP user interface commands. An instance of this class holds the command itself, a textual description of the command''s function and, optionally, an accelerator key that may trigger the command action when used within a menu. The command can be a <Message>, <Symbol> or, indeed, any object that responds to the <commandMessage> protocol. For most commands, symbols are prevalent but messages can sometimes be more convenient, especially if the command is to carry parameters, such as in dynamically constructed menus (e.g. the browser history list).
The MVP command framework operates as follows. There exist a number of potential command sources which each carry a CommandDescription that dictates the command that they wish to transmit. Possible command sources are Menus (drop-down and context), PushButtons and ToolbarButtons. When each source is actioned, the framework determines an appropriate view that can be considered as the origin for the command. Usually this is the view with focus but, in the case of context menus, it is the view beneath the context mouse click.
The next stage is for the framework to determine a suitable target that will perform the command. It does this by creating a CommandQuery object containing the CommandDescription and then routing this via a number of potential command targets to determine if any of these are willing to accept responsibility for executing it. The actual route of command targets is determined by the active CommandPolicy for the originating view. The default CommandPolicy routes the CommandQuery''s in the sequence (view-presenter-model) and so on up the originating view''s parent chain. Normally this default policy is sufficient for most needs, but if necessary the policy can be specialized for a particular View class, or one can interfere with the routing of individual commands by explicitly setting the receiver (eventual target). At each stage in the routing, a potential target object is sent a #queryCommand: message with the CommandQuery as a parameter. This method is responsible for deciding whether the command should be considered as enabled at this target. It does so by setting CommandQuery>>enabled: to true where applicable. When the framework sees that a CommandQuery has been enabled it halts the routing process and gets around to performing command on the last target visited (or on the explicitly set target).
In order to perform the command, a Command object is created from the original CommandDescription and the designated receiver (target) object. The Command object is a valuable which, when performed, executes the command''s message against the receiver. When the command is actually being performed by the appropriate target method, it is possible for this to install some actions that can indicate how the operation may be undone or re-done. If these actions are set (and the top level Shell presenter to which the target belongs has been enabled to retain command history) then the framework will add the Command to its history once it has being performed. This allows an undo/redo facility to be added in a straightforward fashion to almost any application.
Another important aspect of the command framework is the ability to determine whether a particular CommandDescription can be performed without having to actually go-ahead and execute it. This is necessary in order to appropriately enable and disable the various command sources in the user interface. For example, when a menu is pulled down it must correctly display those commands which are enabled and disabled according to the current state of the application. The framework does this by using the same routing scheme that it uses when a command is to be executed. As a menu is pulled down or popped up, all of the commands within it are routed to determine whether their corresponding menu items should be enabled or not. At the same time onecan also indicate whether a particular command should appear checked (#checked:) or not, and specify whether it is considered the default command for its enclosing menu (#isDefault:).
As you can see, it is fairly straightforward for the command framework to determine when to query the commands that originate in menu items since the menus appear at defined times as requested by the user. However, for the various button command sources, the situation is somewhat more complicated since these are continuously visible and a is no obvious moment to perform the query routing. It is therefore necessary for the framework to route a CommandQuery at idle time in order to enable/disable and check/uncheck such items. This process could easily consume far too many processor cycles if not managed carefully. Consequently, the routing operation is only carried out if the user interface has been previously marked as being invalid. This is done by an application sending #invalidateUserInterface to any view or presenter whenever it considers that it has done something to change the application''s state. It is also done automatically by the framework following each command execution, since commands are very often responsible for changing such state.
The end result of a user interface component being marked by #invalidateUserInterface is that it will eventually receive a #validateUserInterface message; usually when the system next enters idle. The various button command sources use this message as a prompt to route a CommandQuery as described above. However, it is acceptable, and may sometimes be useful, to override #validateUserInterface to perform your own explicit interface validation.
The overall aim of the MVP command framework is to provide a flexible routing system to direct commands from their various sources to appropriate target objects that can execute them. The framework effectively implements the Chain Of Responsibility pattern, with the chain being determined by the active CommandPolicy.
Instance Variables:
command <commandMessage> indicating the command to be performed, e.g. a <Symbol> or <Message>
description <readableString> that describes the command to the user.
acceleratorKey <integer> virtual key code for the accelerator key that will trigger this command.
unused Reserved for future use.
'!
!CommandDescription class methodsFor!
command: commandMessage
"Answer a new instance of the receiver for the specified <commandMessage>.
N.B. The command is an identity instance variable."
^self basicNew
initialize;
command: commandMessage!
command: commandMessage description: aString
"Answer a new instance of the receiver with the specified <commandMessage>
"Answer a <readableString> suitable for displaying in a Tool-tip control."
^self description! !
CommandPolicy comment:
'A CommandPolicy determines how a user interface command is routed from its source (menu, toolbar button or pushbutton) to the eventual target that will be responsible for actually performing the command. A route consists of a sequence of potential command targets which in the standard MVP environment are usually (but not essentially) view, presenters or models.
The CommandPolicy in use creates a CommandQuery object and use this to discover whether a command can successfully be performed by any of the potential targets. This is done in #query:. The end result will be a CommandQuery that is bound to a target object and filled in appropriately with information such as whether the command should be considered to be enable, checked, etc. This information is used to determine the state of menu items and toolbar buttons. Since the CommandQuery is bound to a target that is known to be able to accept the command, this can then be performed directly.
The MVP framework creates an instance of CommandPolicy each time it wishes to either determine the status of a command, in order to update the user interface representation of that command, or when the command is to be performed. This class routes from a starting view through its presenter and model. The route then continues with the same sequence moving up the view''s parent chain. If you wish to change the routing policy for a specific view then override #commandPolicy in the particular view class to answer an instance of a different CommandPolicy subclass. New CommandPolicy subclasses will need to override the #routeFrom: method to define their routing policy.
Note: In versions of Dolphin prior to the 3.0 release this class was a singleton. This proved to be inefficient as the system became more sophisticated - in particular the automatic idle time revalidation of toolbars, etc, was causing the route to be regenerated once for every toolbar button.
Instance Variables:
source <View> origin of the commands to be routed.
path <OrderedCollection> of <commandTarget>. The route built by #routeFrom:.
'!
!CommandPolicy class methodsFor!
commandSource: sourceView
"Answer a new instance of the receiver for routing commands
from the <View>, source."
^super new
source: sourceView;
yourself!
defaultClass
"Answer the subclass used by default for command routing."
^DelegatingCommandPolicy!
new
"Instances of the receiver should be created using the #commandSource: message."
^self shouldNotImplement! !
!CommandPolicy methodsFor!
appendPresenter: presenter
"Append the <presenter>, presenter, to the current command path in the standard
way, i.e. also add in the presenter's view, and its model if it is a <commandTarget>.
"A common mistake is to forget to answer the next presenter to visit, so move up to the parent by default
to avoid entering an infinite loop."
next := self visitPresenter: presenter.
presenter := next == presenter
ifTrue: [presenter parentPresenter]
ifFalse: [next]].
^path!
source
"Private - Answer a <View> which is the original command source."
^source!
source: sourceView
"Private - Set the original command source to the <View> argument, sourceView."
source := sourceView.
path := self routeFrom: source!
visitPresenter: presenter
"Private - Visit the <presenter>, presenter, as the next in the chain-of-command,
adding its contributions to that chain. Answer the next <presenter> to visit."
^self subclassResponsibility! !
CommandQuery comment:
'A CommandQuery is used to determine whether, and how, a particular command can be performed. A command is queried in two situations. The first is to determine whether a command source should be enabled and/or checked. When a menu is pulled down it needs to determine the enable, default, and check state of each of its items. Similarly, a PushButton or ToolbarButton will need to determine its state; usually at idle time during #validateUserInterface processing. The second situation arises when a command is to be dispatched and executed. Again a CommandQuery is used to determine the target object that will actually perform it (i.e. the eventual receiver).
To determine the default/enable/checked state of a command, a CommandQuery is created and routed (using the current CommandPolicy) through each of the #queryCommand: methods of the potential target objects. The #queryCommand: method is responsible for using the #isDefault, #enabled: and #checked: methods to set the state of the command at that target location. If, at any point in the routing, a target object sets the CommandQuery as being enabled then the framework will determine that the target should be the eventual receiver of the command. As of Dolphin 3.0 a #queryCommand: implementation can also explicitly set the receiver to override the frameworks default behaviour. A further enhancement for 3.0 is the ability to specify a default command with #isDefault:, with this becoming the default menu item.
Note that a target may also explicitly set the #text: of a CommandQuery as part of the #queryCommand: interrogation. If this is done then the original menu or button text will be dynamically replaced by the newly specified text. Complete dynamic menus must be constructed by overriding <presenter>.onAboutToDisplayMenu:
Instance Variables:
commandDescription <CommandDescription> specifying the command being queried.
receiver <Object> indicating the target that will accept the command.
source <view> where the command originated.
flags <integer> containing various flags indicating the status of the command. '!
!CommandQuery class methodsFor!
commandDescription: item source: aView
"Answers an instance of the receiver for the <commandDescription>, command,
generated by aView"
^(super new initialize)
commandDescription: item source: aView!
initialize
"Private - Initialize the receiver's class variables.
CommandQuery initialize
"
EnabledMask := 1.
CheckedMask := 2.
DefaultMask := 4!
new
"Answers an instance of the receiver on a nil message"
^self commandDescription: CommandDescription new source: nil! !
!CommandQuery methodsFor!
applicationShell
"Answers the <topPresenter> that will be responsible for performing this command."
^self source topShell!
beChecked
"Set the receiver into the checked state"
self isChecked: true!
beDisabled
"Set the receiver into the disabled state"
self isEnabled: false!
beEnabled
"Set the receiver into the enabled state"
self isEnabled: true!
beUnchecked
"Set the receiver into the not checked state"
self isChecked: false!
canPerform
"Answers true if the command described by the receiver can be performed.
This requires a command receiver and that the command is enabled"
^self receiver notNil and: [self isEnabled]!
canPerformAgainst: destination
"Answer whether the command being queried by the receiver can
be performed against the hypothetical <commandTarget>, destination."
"Set the receiver of this command to anObject. Usually sent by queryCommand:
during command routing"
receiver := anObject!
source
"Answers the source of the command"
^source!
source: aView
"Private - Set the message source the receiver to aView"
source := aView.!
text
"Answer the text state of the receiver"
^text!
text: aString
"Set the text state of the receiver to aString"
text := aString! !
COMObjectRegistration comment:
'<COMObjectRegistration> is a simple class to aggregate the registration information for a COM object such as its CLSID and description. It is used in conjunction with the COM Category Manager interface, <ICatInformation>.
Instance Variables:
clsid <CLSID>. Coclass guid.
name <String>. Short description of the coclass from the registry.
toolboxBmp <Image>. Iconic representation for the coclass.
'COMObjectStub is a private class of objects which are used to wrap any object in the system so that they may be exposed as COM objects. COMObjectStub implements most <IUnknown>, functionality, providing reference count based lifetime management, and the basic mechanics for QueryInterface().
Note that each COM server objecty should have only one COMObjectStub so that the ref. count is correct, and so that queries for IUnknown always answer the same interface.
Instance Variables:
cookie <SmallInteger>. The receiver''s cookie identifying it in the Processor registry.
object <Object>. The actual COM server object implementing the COM interfaces.
count <integer>. COM reference count.
interfaces <Array>. Array of interfaces currently extant against this stub.
outerUnknown <IUnknown> or <UndefinedObject>. Controlling (outer) unknown.
Class Variables:
IdentityRegistry <IdentityDictionary>. Map of objects to their COMObjectStub wrapper.
'!
!COMObjectStub class methodsFor!
disconnectAll
"Rudely disconnect all external clients of COM objects implemented in Dolphin.
This should be seen as a forced shutdown measure."
"Answer the map of ip's to source code ranges if such was requested (if not, then nil)."
| sz |
textMap isNil ifTrue: [
sz := rawTextMap basicSize.
"Convert to more useful form"
textMap := OrderedCollection new: sz//3.
1 to: sz by: 3 do: [ :i |
textMap add: (rawTextMap at: i) -> ((rawTextMap at: i + 1) to: (rawTextMap at: i + 2))]].
^textMap! !
CompiledCode comment:
'CompiledCode is the class of executable objects containing an array of instructions (bytecodes) and an array of literals (the literal frame).
The method header of the receiver is a SmallInteger containing a set of flags containing information such as the number of arguments, the number of temporaries, etc, is layed out as follows (subject to change):
Bits: Use:
0 SmallInteger flag (not visible in Smalltalk)
1..4 not used
5 Private flag
6 Debug flag
7 Full Block flag
8..15 Temp count (i.e. maximum of 256 temps)
16..23 Arg count (i.e. maximum of 256 args)
24..31 Primitive index
Primitive indices 0 thru 8 describe the method type as follows:
0 Normal method requiring activation
1 Return self
2 Return true
3 Return false
4 Return nil
5 Return literal constant zero
6 Return an instance variable (see the bytecodes to determine which)
7 Set an instance variable
8 Reserved for future use.
Note: These are implementation details, and should not be relied upon as they may be changed in future versions.'!
!CompiledCode class methodsFor!
elementsExpired: anInteger of: infoCacheKeys
"Private - Some instances of the receiver with entries in the debug info cache were
GC'd, so clean out any corresponding debug info from the cache."
InfoCacheKeys nilCorpsesAndDo: [:i | InfoCacheValues at: i put: nil]!
initialize
"Private - Initialize the class variables of the receiver.
CompiledCode initialize
"
HasBlockMask := 16r40.
DebugMask := 16r20.
PrivateMask := 16r10.
self initializeInfoCache!
initializeInfoCache
"Private - Initialize the cache of method information used for debugging.
CompiledCode initializeInfoCache
"
self initializeInfoCache: 100!
initializeInfoCache: capacity
"Private - Initialize the cache of method information used for debugging to the
^rtf copyFrom: PrologueSize+1 to: rtf size - MethodEpilogueSize.! !
DeadObject comment:
'DeafObject is a singleton whose sole instance is used to mark the slots previously occuppied by dead objects in objects with weak references. This class serves no other purpose than to provide a unique ''Corpse'' object which prints in a recognisable form.
N.B. It is not a good idea to create a new current DeadObject as this may break existing weak collection and/or confuse the VM.
Class Variables:
Current <DeadObject>. Singleton instance.
'!
!DeadObject class methodsFor!
current
"Answer the singleton DeadObject."
^Current!
current: aDeadObject
"Private - Record a new singleton DeadObject.
N.B. Use with extreme care since existing DeadObjects may now be invisible."
Current := aDeadObject!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Private - Initialize the receiver's class variables."
Current isNil ifTrue: [Current := self new]!
removeFromSystem
"Private - Remove the receiver completely from the system.
This class is critical to system operation and must not be removed."
^self shouldNotImplement! !
DeafObject comment:
'DeafObject is a singleton class whose sole instance is deaf to all requests - i.e. it appears to understand all messages, but takes no action except to answer itself. This ensures that the results of all message sends to the DeafObject are also deaf. DeafObject can be useful for avoiding a proliferation of #isNil tests.
N.B. DeafObject cannot be used to substitute for any object which has special significance to either the Compiler or the VM, a good example being <Boolean>s. The following expression will raise a ''Must be boolean'' error because it is not a true message send:
DeafObject current ifTrue: []
Class Variables:
Current <DeafObject>. Singleton instance.
'!
!DeafObject class methodsFor!
current
"Answer the singleton <DeafObject>."
^Current!
icon
"Answers an Icon that can be used to represent this class"
^DeadObject icon!
initialize
"Private - Initialize the receiver's class variables."
Current isNil ifTrue: [Current := self new]! !
!DeafObject methodsFor!
= comparand
"Answer whether the receiver and the <Object>, comparand,
are considered equivalent (in whatever respect is appropriate for
the class of the receiver). All DeafObjects are considered equal."
^self class = comparand class!
doesNotUnderstand: aMessage
"The receiver is deaf to all requests. Answer self to ensure that
our answers are also deaf."
^self!
mustBeBoolean
"Private - Sent to the receiver by the VM when an attempt was made to test it
for its boolean status by a CompiledMethod.
Note that it is normally necessary for implementors of #mustBeBoolean to return a
boolean value, or not return at all. If a non-boolean value is returned, then it
in turn will be sent a #mustBeBoolean message too. This could potentially continue
indefinitely, causing an unbreakable loop."
^true! !
DeferredValue comment:
'A DeferredValue is a <niladicValuable> which is evaluated asynchronously in a background process, but which supplies its value synchronously on request, i.e. it blocks any sender of #value until the value is available.
Instances of DeferredValue are typically created by sending the #deferredValue (calculate in background process forked at same priority as active process) and #deferredValueAt: (calculate in a background process at the specified priority) messages, but there is a class side instance creation protocol (#evaluate:[|with|#with:with:|withArguments:]at: which can be used to defer the calculation of other valuables.
Note that if an exception occurs in the deferred operation it is raised in both the asynchronous process calculating the deferred value, AND any client processes (senders of #value). This is the default behaviour because the deferred value may never be requested, in which case the error would go undetected.
To suppress exceptions in the asynchronous process wrap the deferred operation in an exception trap which catches any <Error>s and answers them as the value of the operation. Any such suppressed <Error> will still be raised in the client process(es) requesting the deferred value, and of course these can be handled (or ignored) as normal. For example:
[["...operation which might raise an error..."]
on: Error do: [:e | e]] deferredValue
Alternatively create a subclass which overrides #_evaluate:withArguments: which includes such a generic error trap.'!
!DeferredValue class methodsFor!
evaluate: operation at: priority
"Answer a <niladicValuable> that begins evaluating the <niladicValuable>, operation,
asynchronously at the specified <integer> priority, and which when evaluated will
'<Delay>s are used to introduce timed pauses in the execution of a <Process>. Delays can be constructed that specify a duration using the instance creation messages #forMilliseconds: and #forSeconds:, or an absolute time based on the millisecond clock value (#untilMilliseconds:). Once constructed a Delay responds to the #wait message by suspending the active process for the desired duration, or until the desired absolute time is reached.
Delays are "one-shot" in that once they have expired further attempts to #wait on them will return immediately. This applies even if the Delay was originally constructed to wait for a time interval rather than an absolute time. Therefore if one wishes to delay a process in a loop, new Delay instances should be created as required inside the loop. It is often more convenient to use the ProcessorScheduler>>sleep: message, which wraps up the creation and wait operations inside a convenience message.
Delays are not hard real time, in that the requested delay is the minimum time period that will elapse before the process is restarted. The VM will make a best effort to reschedule the process after the desired delay by using the high-resolution multimedia clock (accurate to 1 millisecond) and high priority threads, but there may still be an arbitrary additional delay before the Process actually restarts depending on the load on the host machine and the relative priority of the Dolphin thread in relation to other OS threads, and the waiting Process in relation to other Processes. There is also some context switching and other processing overhead that will increase the average minimum Delay to a period greater than 1mS, though (depending on machine speed) it should be quite close.
duration <integer> number of milliseconds to delay Process
resumptionTime <integer> value of millisecond clock at which to resume
waitSemaphore <Semaphore> on which to delay Process
Class Variables:
Current <Delay> the next scheduled Delay (or nil if none)
AccessProtect <Semaphore> protects the class variables in critical regions
Pending <SortedCollection> of waiting <Delay>s in ascending order of resumptionTime.
Resolution <integer> resolution of millisecond clock, minimum 1
TimingProcess <Process> responsible for waking up delayed processes on expiry of Delay
ImageClock <integer> millisecond clock value on last image save - used to reschedule delays on image restart
TimerMax <integer> maximum delay recordable with the timing device. Longer delays are achieved by repeatedly rescheduling until the desired period has elapsed.
TimingSemaphore <Semaphore> Signalled by the VM at requested times, governing the operation of the TimingProcess.
'!
!Delay class methodsFor!
aboutToIdle
"Private - The system is about to go idle.
Answer the current millisecond clock value."
self keepAlive.
"Unfortunately under Windows95 the MM timers occassionally fail to fire
(perhaps they cannot be set, but the function does not return any error indication),
if this is a problem for you, then enable this prod."
(false and: [OSVERSIONINFO current isWin9X])
ifTrue: [self prod]!
cancelTimer
"Private - Cancel any previously registered timer."
Processor signal: nil afterMilliseconds: 0.
!
forkTimingProcess
"Private - Start the timing process which manages instances of the receiver. The timing
Process runs at the highest, Timing, priority, to ensure that the signal gets through, regardless
of the priority of its waiting Process relative to the active Process when it fires.
A separate timing Process is used with a single semaphore because the VM can maintain
only a single timer, and because this allows for better management of Delays."
"Private - The receiver has fired, resume the Process suspended on the receiver (if any)."
waitSemaphore signal! !
DigitalSignatureAlgorithm comment:
'This class implements the Digital Signature Algorithm (DSA) of the U.S. government''s "Digital Signature Standard" (DSS). The DSA algorithm was proposed in 1991 and became a standard in May 1994. The official description is available as a Federal Information Processing Standards Publication (FIPS PUB 186, May 19, 1994). A companion standard, the Secure Hash Standard, or SHS (FIPS PUB 180-1, April 17, 1995), describes a 160-bit message digest algorithm known as the Secure Hash Algorithm (SHA). This message digest is used to compute the document signature.
This class was ported from the Squeak original.
Here''s how to use it:
1. The "signer" creates a pair of keys. One of these must be kept private. The other may be freely distributed. For example, it could be built into the signature checking code of an application.
2. When the signer wishes to sign a packet of data (a "message") , he uses the secure hash algorithm to create a 160-bit message digest (hash) which is used as the input to DSA. The result of this is a pair of large numbers called a "signature" that is attached to the original message.
3. When someone receives a signed message purported to have come from the signer, they compute the 160-bit hash of the message and pass that, along with the message signature and the signer''s public key, to the signature verification algorithm. If the signature checks, then it is virtually guaranteed that the message originated from someone who had the signer''s private key. That is, the message is not a forgery and has not been modified since it was signed. For example, if the message contains a program, and the recipient trusts the signer, then the recipient can run the program with the assurance that it won''t do anything harmful. (At least, not intentionally. A digital signature is no guarantee against bugs!! :->)
The signer must keep the private key secure, since anyone who has the private key can forge the signer''s signature on any message they like. As long as the secret key is not stolen, cryptographers believe it to be virtually impossible either to forge a signature, to find a message that matches an existing sigature, or to discover the signer''s private key by analyzing message signatures. Knowing the public key (which, for example, could be recovered from an application that had it built in), does not weaken the security at all.
An excellent reference work on digital signatures and cryptography in general is:
Schneier, Bruce
"Applied Cryptography: Protocols, Algorithms, and Source Code in C"
John Wiley and Sons, 1996.
I (John Maloney) used this book as a guide to implementing many of the numerical algorithms required by DSA.
Patents and Export Restrictions:
Many digital signature technologies are patented. DSA is also patented, but the patent is owned by the U.S. government which has made DSA available royalty-free. There is a claim that the government patent infringes on an earlier patent by Schnorr, but the government is requiring the use of DSA, so they apparently believe this claim is not strong enough to be a serious threat to their own patent.
Most cryptography technology, including digital signature technology, requires an export license for it to be distributed outside the U.S. Recent legislation may have relaxed the export license requirements, but it would be prudent to check the current regulations before exporting this code.'!
"Private - Interpret an unused quad byte instruction."
self printUnusedPrefix: (interpreter byteCodes at: interpreter ip - 2).
stream
nextPutAll: ' with extension '; print: extensionByte1;
nextPutAll: ' and '; print: extensionByte2;
nextPutAll: ' and '; print: extensionByte3; cr
! !
DiskVolumeInformation comment:
'DiskVolumeInformation can be used to access various statistics and various other items of information available through the Win32 API about disk volumes, for example the disk volumne label and serial number of the disk in a particular drive.
Example Usage:
DiskVolumeInformation forPath: ''c:\'''!
!DiskVolumeInformation class methodsFor!
forPath: rootPath
"Answer a new instance of the receiver for the <readableString> rootPath of a particular disk
self forPath: 'C:\'
"
^self new
setPath: rootPath;
yourself!
forSystemPath
"Answer a new instance of the receiver for the system disk
self forSystemPath
"
^self forPath: SessionManager current systemDirectory! !
!DiskVolumeInformation methodsFor!
bytesPerSector
"Answer the value of the receiver's ''bytesPerSector'' instance variable."
'A DolphinSureCertificateStore is used to store DolphinSureCertificates for later retrieval. The implementation uses the Windows Registry under HKEY_CURRENT_USER and certificates are stored as binary bytes (streamed out using STB). They can be looked up by serial number.
Currently, three such stores are defined and can be accessed by the following class methods:
#myCertificates -- is used to store your own personal certificates that have been issued to. When you receive a certificate it will be in the form of an ST text file with a series of Smalltalk expressions that can be used to regenerate the certificate instance. Once this is done there is also an expression to store the certificate into your "my certificates" store.
#temporaryTrust -- is used to store certificates for publishers that should be trusted in future, but only within the current Dolphin session. If a certificate is added to this store then any content from the publisher will be automatically trusted until Dolphin (or the current DolphinSure application) shuts down. For example, if a user chooses to trust the publisher of a particular web applet, the publisher''s certificate will be added to the temporary trust store so that further prompts for each class that is loaded are unnecessary. This store is cleared down whenever the image starts. This store is used by the Dolphin web applet plug-in but can also be used by other applications.
#permanentTrust -- is used to store certificates for publishers that are to be permanently trusted in future. Certificates are typically added to this store if the user ticks the box marked, "Always trust content from this publisher?", when faced with a SignedClassWarning dialog. This store is used by the Dolphin web applet plug-in but can also be used by other applications.
Instance Variables:
regKey <RegKey> identifying the registry location of certificates held by this store.
'A DolphinSureTrustedData object represents data that has been encrypted with a particular publisher''s certificate. The intent is that the data can be guaranteed as originating from a particular publisher (identified by the encapsulated certificate) and that it can also be trusted not to have been modified since it was published. It is not used as a means of transmitting "secret" data (since anyone can directly see it) but as a means of transmitting signed data.
In order to create a piece of signed/trusted data it is necessary to have a DolphinSureCertificate and a matching private key. These can be obtained by applying to a DolphinSure certificate authority such as Object Arts Ltd (http://www.object-arts.com/DolphinSure). The raw data is signed by first hasing with the SecurehashAlgorithm and then encrypting the result using the DigitalSignatureAlgorithm and the private key of the publisher''s certificate. The point is that, the key can be easily verified to match the hash of the data and it is therefore very difficult to forge another message that pertains to be from the same source.
'ExceptionSet is a system class forming part of the Dolphin exception handling system''s implementation. It is used to collect together multiple <exceptionSelector>s specified in a comma separated list as the first argument to a #on:do: message to a <niladicBlock>.'!
!ExceptionSet class methodsFor!
new
"Answer a new instance of the receiver."
^super new initialize!
with: selector1 with: selector2
"Private - Answer a new instance of the receiver containing
the <exceptionSelector> arguments, selector1 and selector2"
"Private - Answer the receiver's assembler thunk."
thunk isNil ifTrue: [ self makeProcInstance ].
^thunk!
valueWithArgumentsAt: anAddress
"Private - Evaluate the receiver with arguments instantiated from the raw data at anAddress.
For performance and consistency (with outbound external calls) reasons, we use a VM supplied
primitive to instantiate and push the arguments and perform the message, but there is no reason
that this cannot be done in Smalltalk if different argument conversions are required. The standard
conversions are the same as those performed for return types by the external call primitive (see
the ExternalLibrary class)."
^self subclassResponsibility! !
ExternalDescriptor comment:
'The argument/return types supported by the primitive DLL call function are:
void Only valid as a return type - the method answers self
lpvoid General pointer type, accepts byte objects e.g. Strings (pointer to contents
passed), nil (null pointer), integers (passes as address), or ExternalAddresses
(the contained address is passed, not a pointer to the ExternalAddress object).
When used as a return type, the method answers an instance of ExternalAddress.
lppvoid Pointer to pointer. Used for functions which take a parameter into which they write
an address. The corresponding argument must be an ExternalAddress (or other indirection
object), or an object whose first instance variable is such (e.g. an ExternalStructure).
The address of the ExternalAddress itself is passed, so that on return it contains the
address written back by the external function. nil is not a valid argument value.
As a return type answers a pointer instance of LPVOID (i.e. LPVOID* = void**).
char Signed character. Accepts Characters only.
byte Unsigned byte. Accepts SmallIntegers only. Passes a 32-bit value
generated by zero extending the least significant byte. Fails if not in the
range 0..255. Zero extends into a positive SmallInteger when a return value.
sbyte Signed byte. Accepts SmallIntegers only. Passes a 32-bit value generated
by sign extending the least significant byte. Fails if not in range -128..127.
Sign extends into a positive or negative SmallInteger when a return value.
word Unsigned word. As #byte, but 16-bit, acceptable range 0..65535.
Also accepts a byte object of size 2, which is zero extended to 32-bits.
sword Signed word. As #sbyte, but 16-bit, acceptable range -32768..32767.
Also accepts a byte object of size 2, which is sign extended to 32-bits.
dword Unsigned double word (32-bits), accepts 32-bit Integers. Positive integers
are passed as unsigned, and negative integers in their two''s complement
representation. The largest negative LargeInteger which can be passsed
is -16r80000000 (or -2147483648) because this is the largest negative number
which can be represented in 32-bits in two''s complement notation.
Also accepts byte objects of length 4, assumed to be in an unsigned bit representation.
nil is passed as 0. As a return type, answers a SmallInteger, or a LargeInteger if the
result cannot be represented as a positive SmallInteger (i.e. in 30 bits).
sdword Signed double word, accepts any Integer in the range -16r80000000..16r7FFFFFFF
(i.e. Integer''s with a 32-bit two''s complement representation - all SmallIntegers and
4-byte LargeIntegers). May also be other byte objects of length 4, which are
assumed to contain a 2''s complement 32-bit number.
As a return type answers a SmallInteger, or, if more than 31-bits are required
to represent the two''s complement result, a LargeInteger. Also accepts nil (passed as 0).
qword Unsigned quad word. Similar to dword, but 64-bit (i.e. the range is -16r8000000000000000,
the largest 64-bit two''s complement negative integer, up to 16rFFFFFFFFFFFFFFF the largest positive
unsigned 64-bit integer). 8-byte objects are acceptable and assumed to contain the correct unsigned
bit representation. nil is passed as 0.
sqword Signed quad word. Accepts any Integer in the range which can be represented as a
two''s complement number in 64 bits (i.e. -16r8000000000000000 to 16r7FFFFFFFFFFFFFFF).
Also accepts 8 byte objects, which are assumed to contain 64-bit two''s complement numbers.
nil is passed as 0. As a return type answers the smallest Integer form which can contain
the 64-bit two''s complement integer.
bool Boolean. As an argument type, accepts true (translated to 1) or false
(translated to 0). Also accepts SmallInteger values, pushing their host
machine representation. As a return type, if the result is 0 answers false,
if the result is non-zero, answers true.
handle 32-bit handle. Accepts 32-bit integers, nil, or a byte object of size 4.
As a return type, answers an ExternalHandle, unless the
returned handle is NULL, in which case answers ''nil''.
double 64-bit floating point. Accepts instances of class Float (which contains
a host machine representation of a double precision floating point number).
SmallIntegers may also be passed (they are promoted to the double precision
floating point representation of their integral value). As a return type,
answers an instance of class Float.
lpstr Pointer to C (null-terminated) ASCII string type. Accepts null terminated byte
objects (e.g. Strings, Symbols) or nil (null pointer). When used as a return type,
answers a String containing the characters of the C string up to the null terminator.
Unlike lpvoid, does not accept integer values as pointers, or ExternalAddress
(indirection) objects. If the validation is too tight for your requirements, then
use lpvoid. Do not use this return type where an external function is called which
expects the caller to assume ownership of the returned string, and to delete it when
it is no longer required, as a memory leak will result (use lpvoid instead).
oop Object identifier. Any non-SmallInteger can be passed. This parameter type
is intended for use with the forthcoming User Primitive Kit. The value should
be treated as an opaque Handle, and should not be stored for later use (it
may change during a GC). As a return type, answers the object whose Oop is
the result. At present it is recommended that you do not use this type.
float 32-bit floating point. Accepts instances of class Float, or SmallIntegers
(as #double). The conversion of Floats (64-bit double precision) to #float
(32-bit single precision) may result in silent loss of precision. As a return
type answers an instance of class Float (i.e. promotes to double precision).
hresult 32-bit signed integer value. Validation as #sdword. As a return type, if less than
0 (i.e. severity is error), causes the external call primitives to fail with a negative
failure reason which is the HRESULT value. This is convenient because it means an
exception is automatically generated when an external function returns an HRESULT error.
<struct> Where <struct> is an ExternalStructure class name. Structure passed by value. Accepts
only the exact matching structure class. Again, the ExternalStructure arguments may be
reference/pointer instances. When used as a return value, an instance of the
ExternalStructure class is answered, with the bytes of the returned structure as its contents
(copied into a ByteArray).
<struct>* Where <struct> is an ExternalStructure class name. When used as a return type, a pointer
instance of the ExternalStructure is answered, with an ExternalAddress pointing at the
externally stored value as its first instance variable.
<struct>**Equivalent to lppvoid.
Note that in general, the UndefinedObject, nil, is interchangeable with 0, or NULL, when interfacing with external library functions. Nullness can be tested with the #isNull message, with the UndefinedObject and SmallInteger zero answering true.'!
!ExternalDescriptor class methodsFor!
argumentTypes: argString
"Answer an instance of the receiver instantiated from the argument, which
is a String specifying a list of argument types in the standard Dolphin
format. The return type is defaulted to 'dword' and the calling convention
'ExternalLibrary is the class of objects which represent shared, external, function libraries (i.e. DLLs). Each DLL is represented by a separate subclass, with the methods of that subclass corresponding to functions exported from the DLL. The functions are a special form of primitive method (actually instances of <ExternalMethod>) containing the additional type information needed to interface to statically typed functions. The functions are invoked by sending Smalltalk messages int the normal way, with these being translated by the VM external call primitive to the actual function invocations. The VM coerces the Smalltalk objects passed as arguments to appropriate native types following certain rules (see below). The external call primitive will fail if a type mismatch occurs, and normally this will result in an InvalidExternalCall exception being raised (assuming the #invalidCall method has not been overridden).
External library classes are typically singletons, with the instances representing an "open" (usable) instance of the DLL. The singleton instances are accessible through the class #default method. The libraries are loaded lazily, on demand (but see <PermanentLibrary>).
The external call primitive supports the two most commonly used calling conventions:
__declspec(cdecl) - #stdcall
__declspec(stdcall) - #cdecl
The "fastcall" calling convention is not currently supported, but this is rarely (if ever) used for exported functions. The C++ "thiscall" calling convention (which passes the ''this'' pointer in the ECX register) is not supported either, but invoking virtual methods of C++ objects (and therefore COM interface methods) is possible - see IUnknown and its subclasses in the "OLE COM" package.
Apart from scalar types, the primitive also supports the passing and returning of structures by value, up to a maximum of 64Kb per structure (though passing such large structures by value is not recommended).
The argument/return types (and coercions) supported are:
void Only valid as a return type - the method answers self
lpvoid General pointer type, accepts byte objects e.g. Strings (pointer to contents
passed), nil (null pointer), integers (passes as address), or ExternalAddresses
(the contained address is passed, not a pointer to the ExternalAddress object).
When used as a return type, the method answers an instance of ExternalAddress.
lppvoid Pointer to pointer. Used for functions which take a parameter into which they write
an address. The corresponding argument must be an ExternalAddress (or other indirection
object), or an object whose first instance variable is such (e.g. an ExternalStructure).
The address of the ExternalAddress itself is passed, so that on return it contains the
address written back by the external function. nil is not a valid argument value.
As a return type answers a pointer instance of LPVOID (i.e. LPVOID* = void**).
char Signed character. Accepts Characters only.
byte Unsigned byte. Accepts SmallIntegers only. Passes a 32-bit value
generated by zero extending the least significant byte. Fails if not in the
range 0..255. Zero extends into a positive SmallInteger when a return value.
sbyte Signed byte. Accepts SmallIntegers only. Passes a 32-bit value generated
by sign extending the least significant byte. Fails if not in range -128..127.
Sign extends into a positive or negative SmallInteger when a return value.
word Unsigned word. As #byte, but 16-bit, acceptable range 0..65535.
Also accepts a byte object of size 2, which is zero extended to 32-bits.
sword Signed word. As #sbyte, but 16-bit, acceptable range -32768..32767.
Also accepts a byte object of size 2, which is sign extended to 32-bits.
dword Unsigned double word (32-bits), accepts 32-bit Integers. Positive integers
are passed as unsigned, and negative integers in their two''s complement
representation. The largest LargeNegativeInteger which can be passsed
is -16r80000000 (or -2147483648) because this is the largest negative number
which can be represented in 32-bits in two''s complement notation.
Also accepts byte objects of length 4, assumed to be in an unsigned bit representation.
nil is passed as 0. As a return type, answers a SmallInteger, or a LargePositiveInteger if the
result cannot be represented as a positive SmallInteger (i.e. in 30 bits).
sdword Signed double word, accepts any Integer in the range -16r80000000..16r7FFFFFFF
(i.e. Integer''s with a 32-bit two''s complement representation - all SmallIntegers,
some 4-byte LargePositiveIntegers and LargeNegativeIntegers). May also be other
byte objects of length 4, which are assumed to contain a 2''s complement 32-bit number.
As a return type answers a SmallInteger, or if more than 31-bits are required
to represent the two''s complement result, a LargePositiveInteger or LargeNegativeInteger
depending on sign. Also accepts nil (passed as 0).
qword Unsigned quad word. Similar to dword, but 64-bit (i.e. the range is -16r8000000000000000,
the largest 64-bit two''s complement negative integer, up to 16rFFFFFFFFFFFFFFF the largest positive
unsigned 64-bit integer). 8-byte objects are acceptable and assumed to contain the correct unsigned
bit representation. nil is passed as 0.
sqword Signed quad word. Accepts any Integer in the range which can be represented as a
two''s complement number in 64 bits (i.e. -16r8000000000000000 to 16r7FFFFFFFFFFFFFFF).
Also accepts 8 byte objects, which are assumed to contain 64-bit two''s complement numbers.
nil is passed as 0. As a return type answers the smallest Integer form which can contain
the 64-bit two''s complement integer.
bool Boolean. As an argument type, accepts true (translated to 1) or false
(translated to 0). Also accepts SmallInteger values, pushing their host
machine representation. As a return type, if the result is 0 answers false,
if the result is non-zero, answers true.
handle 32-bit handle. Accepts 32-bit integers, nil, or a byte object of size 4.
As a return type, answers an ExternalHandle, unless the
returned handle is NULL, in which case answers ''nil''.
double 64-bit floating point. Accepts instances of class Float (which contains
a host machine representation of a double precision floating point number).
SmallIntegers may also be passed (they are promoted to the double precision
floating point representation of their integral value). As a return type,
answers an instance of class Float.
lpstr Pointer to C (null-terminated) ASCII string type. Accepts null terminated byte
objects (e.g. Strings, Symbols) or nil (null pointer). When used as a return type,
answers a String containing the characters of the C string up to the null terminator.
Unlike lpvoid, does not accept integer values as pointers, or ExternalAddress
(indirection) objects. If the validation is too tight for your requirements, then
use lpvoid. Do not use this return type where an external function is called which
expects the caller to assume ownership of the returned string, and to delete it when
it is no longer required, as a memory leak will result (use lpvoid instead).
oop Object identifier. Any non-SmallInteger can be passed. The value should
be treated as an opaque Handle, and should not be stored for later use (it
may change during a GC). As a return type, answers the object whose Oop is
the result. At present it is recommended that you do not use this type.
float 32-bit floating point. Accepts instances of class Float, or SmallIntegers
(as #double). The conversion of Floats (64-bit double precision) to #float
(32-bit single precision) may result in silent loss of precision. As a return
type answers an instance of class Float (i.e. promotes to double precision).
hresult 32-bit signed integer value. Validation as #sdword. As a return type, if less than
0 (i.e. severity is error), causes the external call primitives to fail with a negative
failure reason which is the HRESULT value. This is convenient because it means an
exception is automatically generated when an external function returns an HRESULT error.
<N> Where N is the byte size of a pass-by-value structure of unspecified type. Accepts either
byte objects (of the correct size) or ExternalStructure instances with the correct byteSize
(or other classes with the same shape as ExternalStructures). ExternalStructures passed
to such arguments can be reference instances (i.e. ones containing a pointer to the actual
structure bytes, rather than the structure bytes themselves). As a return type, the result
is a ByteArray of the specified size.
<struct> Where <struct> is an ExternalStructure class name. Structure passed by value. Accepts
only the exact matching structure class. Again, the ExternalStructure arguments may be
reference/pointer instances. When used as a return value, an instance of the
ExternalStructure class is answered, with the bytes of the returned structure as its contents
(copied into a ByteArray).
<struct>* Where <struct> is an ExternalStructure class name. When used as a return type, a pointer
instance of the ExternalStructure is answered, with an ExternalAddress pointing at the
externally stored value as its first instance variable.
Note that in general, the UndefinedObject, nil, is interchangeable with 0, or NULL, when interfacing with external library functions. Nullness can be tested with the #isNull message, with the UndefinedObject and SmallInteger zero answering true.'!
!ExternalLibrary class methodsFor!
clear
"Private - Clear down cached external function addresses from previous runs.
The default instances will be lazily re-opened because their handles will be null
on image re-start (ExternalHandles are automatically nulled by the VM on image load).
Similary function addresses will be lazily requeried as required."
'A FileLocator is an abstract root for a hierarchy of subclasses that implement the <fileLocator> protocol.
A <fileLocator> is used map between an external resource pathname and an internal name. First an external name is mapped to an internal form using #relativePathTo:. The latter can be held in the image and later mapped back to it''s is full external name using #localFileSpecFor:.
Several singleton <fileLocator>s are supplied and can be referenced using the following class methods:
#imageRelative - An instance of ImageRelativeFileLocator
#installRelative - An instance of InstallRelativeFileLocator
#absolute - An instance od AbsoluteFileLocator
#default - Answers the #imageRelative locator
For example, say that you want to reference an Icon resource file that is held relative to your current image file (perhaps in the \Resources sudirectory). You want to do this in such a way that if you move your image then the \Resources directory will be expected to move with it.
Here, the path to the icon file will be held within the Icon instance in a form that is relative to the base location of the image directory. Icons also hold the file locator too and use this to map back to the full path of the icon file when it is necessary to load it. Hence if you move your image file, the Icon will still expect to be able to load the icon resource from a location that relative to the image directory.
Typically, this is the behaviour that you''ll want by default. At development time, resources are referenced relative to the image and, at runtime, relative to the executable file (which is effective an image, anyway). For this reason the above example could also have been written as:
Sometimes, especially in the case of development tools, you might want a resource to be referenced relative to the Dolphin installation directory. In this case an InstallRelativeFileLocator would be moe appropriate. Take a look at DolphinSureCertificate>>image, for example. Note that, at runtime, the image location and installation location are treated as the same by a standard RuntimeSessionManager.
Class Variables:
Absolute <AbsoluteFileLocator> instance used for locating files by absolute directory.
InstallRelative <InstallRelativeFileLocator> instance used for locating files relative to the installation directory.
ImageRelative <ImageRelativeFileLocator> instance used for locating files relative to the image directory.
'!
!FileLocator class methodsFor!
absolute
"Answers an instance of the receiver that can be used to locate external files
with an absolute path."
^AbsoluteFileLocator current
!
default
"Answers an instance of the receiver that can be used to locate external files
relative to the current image directory."
^self imageRelative
!
imageRelative
"Answers an instance of the receiver that can be used to locate external files
relative to the current image directory."
^ImageRelativeFileLocator current!
installRelative
"Answers an instance of the receiver that can be used to locate external files
relative to the current installation directory."
^InstallRelativeFileLocator current
! !
!FileLocator methodsFor!
basePath
^SessionManager current imageBase!
findOrImportForeignClass
"An attempt is being made by a ClassLocator to load a class when the dynamic loading capability is not installed.
This is normally available as part of the Web Deployment Kit. Raise an error to the effect that the class cannot be found."
self errorClassNotFound.
!
localFileSpecFor: aStringFilename
"Answer a filespec for aStringFilename relative to the current image
directory. This is the reverse operation to #relativePathTo:, and is performed
'FramingConstraints are used to describe the constraints to be placed on the various edges of a <view> that is to be laid out under the jurisdiction of a FramingLayout manager. When a view is under the control of a FramingLayout it is given an arrangement aspect that consists of a FramingConstraints instance. It is this that describes the relationships for computing the locations of the various edges of the view and the offsets to be applied from these locations.
For each of the edges of the view, a FramingConstraints holds a framing relationship and an offset for the edge position relative to the computed location of this. The framing parameters can be set for each edge using the following pairs of aspects.
#bottomFraming, #bottomOffset
#leftFraming, #leftOffset
#rightFraming, #rightOffset
#topFraming, #topOffset
The #xxxFraming aspects may be set to any of the following symbols:
#fixedParentBottom
#fixedParentLeft
#fixedParentRight
#fixedParentTop
Using the above relationships, the appropriate view edge will be positioned a fixed number of pixels from the specified edge of its parent. The distance is determined by the corresponding offset aspect, which must be an <integer> value.
#fixedViewBottom
#fixedViewLeft
#fixedViewRight
#fixedViewTop
Here, the view edge will be positioned a fixed number of pixels from the specified edge of itself. The distance is determined by the corresponding offset aspect, which must be an <integer> value.
#fixedPreviousBottom
#fixedPreviousLeft
#fixedPreviousRight
#fixedPreviousTop
Here, the view edge will be positioned a fixed number of pixels from the specified edge of the previous view in the z-order sequence. Once again, the distance is determined by the corresponding offset aspect, an <integer> value.
#relativeParentHeight
#relativeParentWidth
With these relationships, the edge is positioned within the view''s parent at a distance computed relative to the parent''s height or width. In these cases the offset must be set to a <number> in the range 0..1.
#centerRelativeParentHeight
#centerRelativeParentWidth
With these relationships, the centre of each view is positioned within the view''s parent at a distance computed relative to the parent''s height or width. Thanks to Ian Bartholomew for supplying the code for these particular constraints. He says: "This works best if all the subviews are the same size. It does still work if this isn''t true but the gaps between subviews are not then identical, although the position of the centre of the button still corresponds to the buttons offset." Also, "The #offset fields need to be structured in a fixed way. If you have three buttons then the offsets, left to right, need to be specified as 1/4, 2/4 (or 1/2) and 3/4 (Floats will not work)."
Note that in all cases a positive offset implies a position down or to the right of the computed location. Negative offsets can be used if the postion is required to be up or to the left.
For example: Position a view so that it''s left edge is 5 pixels in from the left of it''s parent; it''s width is 200 pixels; it''s bottom is at 50% of the parent height and it''s top is 10 pixels below the bottom of the previous view. Use the following FramingConstraints:
dominant: rectangle top parent: parentExtent view: aView].
! !
Grabber comment:
'A Grabber is used to mark view locations for aspects that may be grabbed by the mouse. A ViewComposer uses grabbers to manipulate the size of the current view.
A Grabber will track the mouse, after receiving #trackMouseFrom:, until the mouse button is released at which time it modifies the appropriate aspect of the associated view. Once the operation is complete, that aspect of the view is triggered.'!
!Grabber class methodsFor!
cursors
"Private - Answer the Cursors class variable."
Cursors isNil ifTrue: [
Cursors := IdentityDictionary new
at: #bottomRight put: Cursor sizeNWSE;
at: #topLeft put: Cursor sizeNWSE;
at: #topRight put: Cursor sizeNESW;
at: #bottomLeft put: Cursor sizeNESW;
at: #leftCenter put: Cursor sizeWE;
at: #rightCenter put: Cursor sizeWE;
at: #topCenter put: Cursor sizeNS;
at: #bottomCenter put: Cursor sizeNS;
shrink;
yourself ].
^Cursors
!
defaultExtent
"Private - Answers the default extent to be used for the receiver"
^6 @ 6!
initialize
"Private - Register the receiver with the #onStartup event"
SessionManager current when: #sessionStarted send: #onStartup to: self!
new
"Private - Use #view:aspect:"
self shouldNotImplement!
onStartup
"Private - Clear the Cursors class variable."
Cursors := nil!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #aspectChanged;
yourself.
!
uninitialize
SessionManager current removeEventsTriggeredFor: self!
"Answers the number of pixels between adjacent points in the grid."
^resolution!
resolution: anInteger
"Sets the number of pixels between adjacent points in the grid to anInteger."
resolution := anInteger! !
GUID comment:
'GUID is the class of 128-bit Globally Unique Identifiers (guids) which are used wherever a unique identifier is required in COM, for example to identify specific coclasses and interfaces.
You can easily allocate a new GUID by sending #newUnique to this class. Note that this process is very fast, so there is no particular reason not to use GUIDs for other purposes requiring unique identifiers such as records in a database.
Note: In versions of Dolphin prior to 2.2 GUID was a subclass of ExternalStructure. Although logically GUID belongs under ExternalStructure, it was move for reasons of space efficiency (every class now has a unique GUID).
Instance Variables:
None (byte class)
Class Variables:
Null - The null <GUID>.'!
!GUID class methodsFor!
alignment
"Answer the alignment requirements for the receiver.
Implementation Note: The receiver is actually defined as a structure
of the following form:
typedef struct _GUID {
unsigned long Data1;
unsigned short Data2;
unsigned short Data3;
unsigned char Data4[ 8 ];
} GUID;
This means it's maximum alignment requirement is for a 32-bit integer,
"Private - Answer a new <WinImageList> appropriately configured to hold images for the receiver
of the specified extent."
| answer |
answer := WinImageList
newExtent: aPoint
initialSize: images size
masked: maskcolor notNil.
answer backcolor: backcolor.
^answer!
newImages
"Private - Initialize the receiver's image data structures."
self newImageLists.
images := LookupTable new!
purge
"Empty the receiver of all objects"
self newImages!
purgeImages
"Private - Frees up all the image resources"
Notification signal: 'Purging images from ' , self printString.
self newImageLists!
purgeImagesWithExtent: aPoint
"Private - Removes any image list that contains images of extent, aPoint"
imageLists removeKey: aPoint
!
size
"Answer the number of objects that have been added to the receiver"
^images size!
stbSaveOn: anSTBOutFiler
"Save out a binary representation of the receiver to anSTBOutFiler.
The WinImageLists held by the receiver cannot be binary filed out. We purge them
here so that this is not a necessity. The unfortunate side effect is that the images
will have to be rebuilt next time the receiver is accessed. Perhaps it would be better
to use a true proxy class to avoid this inefficiency."
self purgeImages.
super stbSaveOn: anSTBOutFiler! !
InkStroke comment:
'InkStroke consists of an <OrderedCollection> of <Point>s that describe the movement of a pen (or mouse) drawing a single stroke of ink. A <Scribble> presenter operates on a <listModel> of InkStrokes that, when replayed, comprises the scribbled picture.
Instance Variables:
data <OrderedCollection> of <Points> describing the strokes track.
'!
!InkStroke class methodsFor!
new
"Answer an initialized instance of the receiver"
^super new initialize! !
!InkStroke methodsFor!
addPoint: aPoint
"Adds aPoint to the collection of data points held by the receiver.
Answers aPoint"
^data add: aPoint!
drawOn: aCanvas
"Draw the receiver on aCanvas"
aCanvas moveTo: data first.
data do: [:each | aCanvas lineTo: each].
!
initialize
"Private - Initialize the receiver"
data := OrderedCollection new!
length
"Answer the length of the receiver"
| last delta |
last := self points first.
^(self points inject: 0 into: [:sum :each |
delta := each-last. last := each. sum+delta r]) rounded!
points
"Answer the collection of <Points> associated with the receiver"
^data!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a developer
would want to see it."
aStream
basicPrint: self;
nextPut: $(; display: data size; nextPutAll: ' points)'! !
InputState comment:
'<InputState> is a singleton responsible for managing the windows message loop and related <Process>es.
Instance Variables:
inputSemaphore <Semaphore> on which the UI process blocks when the idle (i.e. when message loop is empty).
idler <Process>. The idle process responsible for relinquishing control to Windows when no other Smalltalk <Process>es are ready to run.
idleTimer <WeakArray> holding <window> currently hosting WM_TIMER used to keep background processing operational when running Windows modal msg loops such as those for common dialogs.
main <Process>. The current main UI process.
windows <LookupTable> of <Integer>. Map of window handles to associated Smalltalk windows (usually <View>s).
deferredActions <SharedQueue> of <niladicValuable>. Actions to be processed by the main process when the message loop is empty.
lastWindow <window> that last received a message (cached because most likely to receive next message too).
wakeupEvent <ExternalHandle> of Win32 Event object signalled by the VM when it wants the image to wake up.
Class Variables:
MaxIdleSleep9x <SmallInteger>. Timeout passed to MsgWaitForMultipleObjects by idle process when on Windows 9x
MaxIdleSleepNT <SmallInteger>. Timeout passed to MsgWaitForMultipleObjectsEx by idle process when on Windows NT
EnumHandlesDescriptor <ExternalDescriptor>. Callback descriptor for EnumWindows.
UserInterruptSignal <Signal>. Exception raised when Ctrl+Break key press detected.
SamplingInterval <SmallInteger> interval (measured in full method/blockactivations) between tests of system input queue for host system messsages when running background processes.
'!
!InputState class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
"Private - Modify Win32's keyboard state to that currently cached."
UserLibrary default setKeyboardState: state
! !
LayoutManager comment:
'LayoutManager is the abstract superclass for classes that wish to implement the <layoutManager> protocol for the automatic arrangement of views within a parent <compositeView>. Dolphin supplies a base set of general purpose concrete layout managers which are general purpose enough to cover most requirements.
To define a new layout manager you must implement the <layoutManager> protocol methods in [subclass responsibility].'!
!LayoutManager class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Answer an instance of the receiver. Instances require initialization"
^super new initialize! !
!LayoutManager methodsFor!
arrangementAspect
"Private - Answer an Aspect description for the arrangement aspect of Views that
are managed by the recever. The default is to allow for a workspace to edit the
arrangement"
^Aspect name: #arrangement!
arrangementOf: aView
"Answer the arrangement parameter of aView in the receiver.
If an arrangement parameter has not explicitly been set
then answer nil. Overidden by subclasses that take notice of
arrangement parameters"
^nil
!
arrangementOf: aView put: anObject
"Set the arrangement parameter of aView in the receiver to be anObject.
The arrangement parameter has different meanings depending on the
class of the receiver. Overidden by subclasses that take notice of
arrangement parameters"
!
layoutContainer: aContainerView
"Performs a layout operation on the contents in aContainerView"
^self subclassResponsibility!
preferredLayoutExtentOf: aContainerView
"Answer aPoint which is the preferred extent when laying out aContainerView"
self subclassResponsibility!
removeSubView: aView
"Remove aView from the collection of views which have been explicitly
arranged by the receiver.
Answer aView."
^aView
!
reposition: aMovedView to: aPoint
"Private - The view, aView, has been moved to aPoint. Ask the receiver to do the repositioning
and layout all the other views under its jurisdiction. In some circumstances the movement
may not be allowed."
self layoutContainer: aMovedView parentView!
resize: aSizedView to: aRectangle
"Private - The view, aView, has been resized to aRectangle. Ask the receiver to do the resizing
and layout all the other views under its jurisdiction. In some circumstances the resize
may not be allowed."
self layoutContainer: aSizedView parentView!
resolutionScaledBy: scale
"Private - The receiver is being loaded and it has been determined that the pixel resolution
has changed since the point at which the view was saved. Scale any internal pixels by <Point>
scale."
! !
Link comment:
'Links are records of a reference to another Link, and are used to represent the linked elements of a <LinkedList>.
Link is an abstract base class which should be subclasses to hold objects of the appropriate type.'!
!Link class methodsFor!
nextLink: aLink
"Answer a new instance of the receiver which refers to aLink as the
link which succeeds it in a LinkedList"
^self new
nextLink: aLink;
yourself
! !
!Link methodsFor!
nextLink
"Answer the next Link in the list after the receiver"
^nextLink
!
nextLink: aLink
"Set the next Link referred to by the receiver to a aLink."
^nextLink := aLink! !
ListViewColumn comment:
'ListViewColumn is a description of a column held by a <ListView>. Note that, columns are only displayed when a list is in #report mode.
Each column is configurable using a number of valuables (usually blocks) which determine how the item objects held by the list are mapped to information to be presented in the column.The first mapping is achieved by the getContentsBlock which, given the list item, determines the object that the column actually represents. How this contents object is then mapped to the displayed text is determined by the getTextBlock. Similarly, the getImageBlock is used to map a contents object to the index of an image to display in the column (the ImageManager that will be used to obtain the actual image is that of the ListView itself). In order to determine how a column will be sorted (an operation that is automatically perform when a column header is clicked) the getSortValueBlock can be set. This takes a contents object and maps it to an appropriate sort value. If it is necessary for a column to display "tip text" then a getInfoTipBlock can be used to specify the mapping between a contents object and this text. The above blocks are initialized to defaults with the following actions:
getContentsBlock - use the list item itself (the primary column object).
getTextBlock - use #displayString on the contents object.
getImageBlock - do not display images.
getSortValueBlock - use the contents object itself.
getTipText - do not display tip text.
One other ListViewColumn aspect worthy of note is #isAutoResize. Normally, columns have a fixed width (specified by the #width aspect) and they do not change size if the parent list is resized. This is the standard behaviour of the underlying Windows control. However, by setting #isAutoResize to true, the ListView will treat the column as dynamically re-sizeable. It will attempt to share the width remaining, after all fixed columns have been accounted for, between each of the auto-resizeable columns.
Instance Variables:
text <readableString> that is the heading text for the column.
width <integer> width of the column in pixels.
alignment <Symbol> describing the alignment (#left, #center, #right) of the text in the column.
getTextBlock <monadicValuable> mapping a contents object to a <readableString> to be displayed.
getSortValueBlock <monadicValuable> mapping a contents object to an object that can be used as the sort basis for the column.
getContentsBlock <monadicValuable> mapping a list item to the column object presented by this column.
compareBlock <dyadicValuable> reserved for future use.
parent <ListView> holding this column.
getImageBlock <monadicValuable>or nil, mapping a contents object to an image index.
isAutoResize <boolean> indicating whether the column should dynamically resize to fill available space.
getInfoTipBlock <monadicValuable> mapping a content object to a <readableString> for the column''s tip text.
'!
!ListViewColumn class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Private - Initialize the class variables of the receiver:
self initialize
"
AutoResizeMask := 1.
SortInvertedMask := 2.!
new
"Answer a new instance of the receiver."
^super new initialize!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
'Magnitude is an abstract class which provides the protocol objects which can be compared
along a linear dimension, e.g. Numbers, Dates, Times.
Subclasses of Magnitude must implement the following comparing protocol (at the very least):
#<, #=, #hash'!
!Magnitude methodsFor!
< operand
"Answer whether the receiver is less than the <magnitude>, operand.
Only this relational operator need be implemented by subclasses, since the others can
be implemented in terms of it (though performance may dictate otherwise)."
^self subclassResponsibility!
<= operand
"Answer whether the receiver is less than or equal to the <magnitude>, operand.
Implemented in terms of #<, which must be implemented by subclasses, also make use
of compiler optimisation of #== instead of #not"
^(operand < self) == false!
= aMagnitude
"Answer whether the receiver is equivalent to the argument, aMagnitude."
^self subclassResponsibility!
> operand
"Answer whether the receiver is greater than the <magnitude>, operand.
Implemented in terms of #<, which must be implemented by subclasses."
^operand < self!
>= operand
"Answer whether the receiver is greater than or equal to the <magnitude>, operand.
Implemented in terms of #<, which must be implemented by subclasses."
^(self < operand) == false!
between: min and: max
"Answer whether the receiver is inclusively between the <magnitude> arguments,
min and max."
^self >= min and: [self <= max]!
hash
"Answer a SmallInteger hash value for the receiver which obeys the invariant that any two
objects which compare equal (using #=) must have the same hash value (but not
necessarily vice-versa). Like #=, and #<, must be implemented by subclasses."
^self subclassResponsibility!
max: operand
"Answer the greater of the receiver and the <magnitude>, operand.
Implementation Note: #< is used since other relational operators are often implemented
in terms of it."
^self < operand
ifTrue: [operand]
ifFalse: [self]!
min: operand
"Answer the lesser of the receiver and the <magnitude>, operand."
^self < operand
ifTrue: [self]
ifFalse: [operand]! !
MemoryManager comment:
'MemoryManager is a singleton class whose sole instance is responsible for scheduling garbage collection, performing finalization, saving the image, etc.
The MemoryManager owns two processes which are responsible for performing certain garbage collection activities in synchronization with the image. The garbage collector itself cannot perform these tasks because it runs asynchronously in the VM. The first of these processes is responsible for sending #finalize messages to objects that were previously marked as finalized before they expired. It does this by consuming objects from a queue which is populated by the collector. This activity is performed at low priority, as in general it is considered that reclaiming resources is a lower priority activity than interactive tasks. Also the asynchronous nature of garbage collection makes it unpredictable when (if ever) an object will actually be ready for finalization. However, to avoid the queue growing indefinitely when a higher priority CPU intensive task is consuming all available cycles, the finalization queue has a "high water mark". When the collector enqueues a finalizable object and finds the queue has passed the high water mark, it sends an interrupt (via the Processor object) to indicate this condition. The MemoryManager responds by temporarily boosting the priority of the finalization task to a relatively high level (above the normal "user" levels), so that it is cleared down quickly.
There is also a "bereavement" queue which is managed in a similar way. The bereavement queue is populated by the collector with weakling objects (i.e. those with weak references) when they lose one or more of those references. Bereaved objects are consumed from the bereavement queue and sent #elementsExpired: messages by the "undertaker" process. A significant difference from the finalization process is that the undertaker runs at a very high priority in order to guarantee that weak objects are repaired immediately.
Note that collections that nil weak references can only be scheduled from the image (e.g. by the background idle process), never asynchronously by the VM. This is so that weak objects can be operated on atomically without the rug being pulled from under their feet by the collector.
Instance Variables:
finalizer <Process>. Low priority task responsible for sending #finalize message to finalizable objects.
lastRequests <Semaphore>. Semaphore signalled the GC when finalizable objects enqueued for finalizer.
hospice <Array>. Queue of objects requiring finalization. Growns dynamically by the GC as required.
hospiceHighWater <integer>. Level at which GC interrupts to notify finalizable garbage building up (default 64)
reserved Reserved for future use.
undertaker <Process>. High priority task responsible for repairing weak collections.
bereavements <Semaphore>. Semaphore signalled by GC when weak collections have suffered bereavements.
bereaved <Array>. Queue of weak collections which have suffered losses.
bereavedHighWater <integer>. Level at which GC interrupts to notify bereaved queue building up (default 32).
gcInterval <integer>. Milliseconds between major GC cycles.
lastGCTime <integer>. Milliseconds clock at last major GC cycle.
lastGCDuration <integer>. Duration in milliseconds of last major GC cycle.
objectHeaderSize <integer>. Number of bytes in object headers allocated by the VM (a constant).
Class Variables:
GCInterval <integer>. Default GC interval.
Current <MemoryManager>. Singleton instance.
'!
!MemoryManager class methodsFor!
current
"Answer the singleton instance of the receiver.
N.B. This instance can only be replaced with #become:, and the format
must be the same."
^Current
!
gcInterval: anInteger
"Set the interval between GC's (idle time) to anInteger"
GCInterval := anInteger!
icon
"Answers an Icon that can be used to represent this class"
^Icon fromId: 13 in: ShellLibrary default!
initialize
"Initialize the class variables of the receiver
Current - The singleton instance of the receiver. Can be replaced with an
alternative memory manager if desired by sending #current:.
GCInterval - Minimum idle time (milliseconds) between scheduled GC's"
GCInterval := 10000.
Current isNil ifTrue: [Current := super new initialize].
"Private - Answer a <sequencedReadableCollection> of the categories of superclass implementations
of the <CompiledMethod>, method. Categories may appear more than once in the collection."
| selector suggestions |
selector := method selector.
suggestions := OrderedCollection new.
method methodClass allSuperclasses do: [ :each |
(each includesSelector: selector) ifTrue: [ | m |
m := each compiledMethodAt: selector.
suggestions addAll: method categories]].
^suggestions! !
MethodContext comment:
''!
!MethodContext methodsFor!
argumentCount
"Private - Answer the number of arguments to the context. In the case of a MethodContext
we ask its associated CompiledMethod. This implementation of #argumentCount does
not imply that MethodContext complies with the ANSI <valuable> protocol (it does not)."
^self method argumentCount!
at: index
"Answer the receiver's indexed instance variable at the argument index.
As basicAt:, but may be reimplemented.
Primitive Failure Reasons:
0 - aSmallInteger is not a SmallInteger
1 - aSmallInteger out of bounds (not in the range 1..receiver's indexable size)."
<primitive: 49>
^self errorAt: index!
at: index put: value
"Replace the receivers indexed instance variable at the argument,
index, with the argument, value. Answer value.
As basicAt:put: but may be reimplemented.
Primitive Failure Reasons:
0 - aSmallInteger is not a SmallInteger
1 - aSmallInteger out of bounds (not in the range 1..receiver's indexable size)
2 - the argument, value, is not of a class which can be stored in the receiver
(e.g. its a non-SmallInteger and the receiver is a ByteArray)."
<primitive: 50>
^self errorAt: index put: value!
frameClass
"Private - Answer the class of StackFrame to represent activations of the
receiver."
^ContextFrame!
hasReturned
"Private - Answer whether the receiver has already returned, and is therefore
inactive. In the case of a MethodContext, if returned it can never be
reactivated, but BlockContexts can be activated and return any number
of times."
^self outer == 0!
home
"Privte - Answer the home context of the context. In the case of a MethodContext,
this is always itself"
^self!
method
"Private - Answer the home method for which the context represents execution state"
^method!
method: aCompiledMethod
"Private - Set the home method for which the context represents execution state."
method := aCompiledMethod!
outer
"Private - Answer a SmallInteger pointer to the receiver's associated stack
frame, or nil if the receiver has already returned."
^frame!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver."
aStream
basicPrint: self;
nextPutAll: ' for ';
print: self method!
receiver
"Private - Answer the 'self' of the context"
^receiver!
receiver: newReceiver
"Private - Set the 'self' of the context"
receiver := newReceiver! !
MethodProtocol comment:
'MethodProtocol is a meta-information class which groups a set of selectors to form a cohesive unit of behavior which is independent of the class hierarchy. A class is said to conform to a MethodProtocol if it implements each of the selectors in the protocol, and if it claims to support the protocol, i.e. implementation of the set of selectors is a necessary but not sufficient condition because the implementation of the selectors must be as specified by the protocol. The precise semantics of the protocol are not formally specified by instances of this class, and cannot be tested by it, therefore if the programmer asserts that a class conforms to a protocol and it implements all the necessary selectors, that is deemed sufficient for conformance. A class automatically conforms to any protocols to which its superclasses conform.
If a method implementing a required protocol selector is removed from a class then the system automatically removes the protocol from the list supported by that class. Conversely if a protocol is extended by the addition of new selectors then this may result in the addition of stub method implementations to all conforming classes which do not currently respond to that selector. These stub methods raise an error when invoked and may be located by browsing the ''not yet implemented'' pseudo-category.
Conformance to a protocol may be tested a run-time by sending the message #conformsToProtocol: to the class. This is akin to send a #respondsTo: message to enquire whether a class understands an individual selector. By maintaining the protocol invariant that all conforming classes must respond to all a protocols selectors the system can perform a very fast conformance test (symbol lookup with in a set, chaining up the class hierarchy).
Each class (ClassDescription) stores a set of the symbolic names of the protocols to which it conforms, excluding those to which its superclasses conform. Testing for protocol conformance (using #conformsToProtocol:) is by symbolic name, and therefore it may be possible to strip the MethodProtocol objects themselves from a run-time application.
It is a good idea to keep protocols small, as this reduces the burden of implementation in a new class (you can quickly add a full set of stub methods in a class by dragging the protocol into the class, or by using the Add/Protocol command, in the Class Hierarchy Browser). You should also avoid extending the system defined protocols: Most of these are as defined by the ANSI Smalltalk Standard.
Instance Variables:
name <Symbol> Unique symbolic name of the protocol (identity)
comment <String> or nil. Description of the protocol (e.g. its specifiction)
selectors <IdentitySet> The set of selectors required by the protocol
flags <integer> Various boolean attributes of the protocol
Class Variables
Protocols <IdentityDictionary> Maps protocol names to instances.
StubAddedSignal <NotificationSignal> Resumable signal raised when a stub method is generated.
ReadOnlyMask <integer> Masks read-only flag from flags instance variable
ANSIMask <integer> Masks ANSI flag from flags instance variable
'!
!MethodProtocol class methodsFor!
allMethodProtocols
"Answer the a <collection> of all <MethodProtocols>s current registered in the system.
MethodProtocol allMethodProtocols size
"
^Protocols asArray!
ansiIcon
"Private - Answers an Icon that can be used to represent an ANSI standard protocol."
^Icon fromId: 'METHODPROTOCOL_ANSI.ICO'!
existing: protocolName
"Answer an existing <MethodProtocol> with the specified
<Symbol> name, protocolName. Signals a NotFound exception
if protocolName does not specify an existing protocol."
^Protocols at: protocolName asSymbol.!
exists: protocolName
"Answer whether the named protocol exists."
^Protocols includesKey: protocolName asSymbol!
icon
"Answers an Icon that can be used to represent this class. Here we use a constant expression
evaluated at compile time in order to statically bind 'self' at this position in the class hierarchy
(i.e. to Object). This ensures that subclasses which do not override this method still answer
'Object defaultIcon' rather than 'aSubclass defaultIcon'. Classes which provide their own default icon
can override this method with a similar implementation perhaps with #defaultIconFrom: if the icon comes
from an ExternalResourceLibrary other than the system default."
^##(self) defaultIcon!
initialize
"Private - Initialize the receiver's class variables.
implementors do: [:i | i addProtocol: self; isChanged: true].
self class environment trigger: #protocolUpdated: with: self!
selectors
"Answer a <collection> of the selectors which make up the receiver's protocol."
^selectors!
setName: stem
"Private - Set the name of the receiver to the <Symbol> equivalent
of the <readableString>, stem."
name := stem asSymbol.
self initialize!
updateBaseClasses
"Private - The receiver has changed in such a way that it's
base classes need to be marked as having been changed."
self baseBehaviors do: [:each | each isChanged: true]
! !
ModalMsgLoop comment:
''!
!ModalMsgLoop class methodsFor!
new
"Answer a new initialized instance of the receiver."
^super new initialize! !
!ModalMsgLoop methodsFor!
initialize
"Private - Initialize the receiver's instance variables."
loop := true!
signal
"Terminate the modal loop, and return control to the sender of #wait."
loop := false!
wait
"Start the modal loop, returning when the receiver is signalled.
While waiting the Windows message loop continues to be serviced,
but keyboard and mouse input is discarded."
SessionManager inputState loopWhile: [loop]! !
Model comment:
'Model is an abstract class whose subclasses implement the <model> protocol and represent domain level data that is likely to be observed by other objects. The Model hierarchy is part of the MVP framework although <model> classes may well be used outside of this framework.
In general, <models> differ from other objects which would otherwise be simply subclasses of Object by triggering change events when aspects of their data are modified. This enables the Observers of this data to keep up-to-date with the changes. In the MVP framework a <view> is typically an Observer of a <model>''s data.
The Model class provides a faster means of event triggering for its subclasses than is available in standard objects but, apart from this it supplies, no new facilities other than to conveniently group classes that be considered to act as models and place them within the <model> protocol.
Instance Variables:
events <EventsCollection> holding the model''s event registrations.
'!
!Model class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Answer a new initialize instance of the receiver."
^super new initialize!
stbConvertFrom: anSTBClassFormat
"Convert from earlier version models.
1: Added 'events' instance variable to Model."
^[:data | | newInst offset |
newInst := self basicNew.
data keysAndValuesDo: [:i :v | newInst instVarAt: i+1 put: v].
newInst]!
stbVersion
"Answer the current binary filer version number for instances of the receiver."
^1! !
!Model methodsFor!
getEvents
"Private - Answer the EventsCollection belonging to the receiver, or nil if the receiver
has no events registered for it"
^events!
postCopy
"Apply any final flourish to the copy that may be required
in order to ensure that the copy does not share any state with
the original. Answer the receiver."
events := nil!
setEvents: anEventsCollectionOrNil
"Private - Set the EventsCollection of the receiver to be anEventsCollectionOrNil.
Answer the receiver."
events := anEventsCollectionOrNil!
stbSaveOn: anSTBOutFiler
"Output the receiver to anSTBOutFiler. We must ensure that the local events collection
is NOT saved to the filer"
anSTBOutFiler override: events with: nil.
super stbSaveOn: anSTBOutFiler.! !
MoenContour comment:
'MoenContour is a private helper class which is part of the implementation of the <MoenTreeView>
'Mutex is the class of process synchronisation objects which provide mutually exclusive access to critical sections, potentially permitting a single process to enter such critical sections multiple times recursively (in some other Smalltalk systems this class is in fact called, RecursionLock).
If any process is in a Mutex, then no other process is permitted to enter that Mutex, but that process may re-enter.
Mutex is particulary useful where the use of a simple mutual exclusion <Semaphore> alone might cause deadlock, e.g. in implementing process safe collections.
Access to the Mutex is through the #critical: method only. Versions of Dolphin prior to 3.0 also supported #wait and #signal messages, but these were not entirely safe.
Instance Variables:
owner <Process> which currently owns the instance, or nil if no owner
semaphore <Semaphore> used for mutual exclusion '!
!Mutex class methodsFor!
new
"Answer a new initialized instance of the receiver."
^super new initialize! !
!Mutex methodsFor!
critical: aNiladicBlock
"Wait until the receiver is NOT owned by another Process than that currently
active, and then evaluate the argument, aNiladicBlock, to the
exclusion of other Processes using this mutex, answering the result.
Implementation Note: We could use Semaphore>>critical: to implement the
#ifFalse: branch, but we code inline to avoid the overhead of a further #ensure:
block to reset the owner instance variable in addition to that in Semaphore>>critical:
which guarantees that the Semaphore is never left unsignalled on exit."
| active stateHolder |
(active := Processor activeProcess) == owner
ifTrue: [^aNiladicBlock value].
"We need to acquire the mutex before we can proceed"
stateHolder := Array new: 1.
^[ "The semaphore primitive will atomically wait AND set the wait result if it completes"
semaphore wait: INFINITE ret: stateHolder.
owner := active.
"Set the state to indicate that the owner has been set and can be tested for premature release"
stateHolder basicAt: 1 put: active.
aNiladicBlock value
] ensure: [ | state |
"There are a number of possibilities:
1: The normal case. The mutex was acquired, and the block evaluated to termination.
2: The mutex was acquired and the block evaluated, but it prematurely released the mutex with #signal.
3: The mutex was acquired, but the process was terminated before it could proceed any further.
4: The process was terminated before the mutex could be acquired.
In case 4 there is no action required."
(state := stateHolder basicAt: 1) == active
ifTrue: [ "Cases 1 & 2"
owner == active ifTrue: [ "Case 1: Normal completion"
owner := nil. semaphore signal]]
ifFalse: [ "Cases 3 & 4"
state == WAIT_OBJECT_0 ifTrue: [ "Case 3: Acquired but not evaluated"
self allToolClasses do: [:each | each removeEventsTriggeredFor: self]! !
ObjectRegistry comment:
'ObjectRegistry is part of Dolphin''s external interfacing support, its purpose being to provide a unique <integer> identifier for a specific object, and, depending on the subclass, to maintain a reference to that object to prevent it from being garbage collected. This can be useful, for example, where one needs some unique identifier for an object to be passed to some external entity.
Note: The Oop (address) of an object is not a suitable candidate for uniquely identifying an object, because it may change over time as the garbage collector moves objects in memory. The identity hash of an object, although time invariant, is not suitable either because it is of limited range (16-bits), and therefore not guaranteed to be unique.
ObjectRegistry itself is abstract: Subclasses implement both permanent registries (that maintain a strong reference to registered objects and thus keep them alive) and weak registries (that reference registered objects only weakly and thus do not prevent them from being garbage collected).
Instance Variables:
registry <sequencedCollection>. The collection of registered objects.'!
!ObjectRegistry class methodsFor!
defaultCapacity
"Private - Answer the default capacity for an instance of the receiver."
^4!
new
"Answer a new permanent object registry with space for the default number of elements."
^self new: self defaultCapacity!
new: anInteger
"Answer a new object registry with initial capacity
for anInteger elements."
^self basicNew initialize: anInteger! !
!ObjectRegistry methodsFor!
addAnsweringIndex: anObject
"Register the argument, anObject, answering a unique SmallInteger id which can be used
subsequently to retrieve that object."
^self subclassResponsibility!
at: anInteger
"Answer the object registered with the receiver with the specified id.
If the id is invalid, raise an exception.
Implementation Note: Although we could check to see if the object
with the specified id is a valid object, we cannot detect the situation
where an id has simply been reused, so we don't bother to incur the overhead."
^registry basicAt: anInteger!
at: anInteger ifAbsent: exceptionHandler
"Answer the object registered with the receiver with the specified id.
If the id is out of bounds, evaluate the niladic valuable argument, exceptionHandler."
"Answer the name of the receiver. This must always be the same as the stem of the package's
file name, and must be unique amongst all loaded packages in the system."
^name!
nameForClass: aClass
"Private - Answer a String name suitable for adding to the receivers classNames.
See: Package>>classFromName for the reverse transformation.
Implementation Note: As of package binary file version 1, we store the class names
as Symbols to avoid wasting space."
^aClass name!
nameForMethod: aMethod
"Private - Answer an Association of the method class name String -> methods selector Symbol.
See: Package>>methodFromName for the reverse transformation."
^self class nameForMethod: aMethod!
nameForResourceIdentifier: aResourceIdentifier
"Private - Answer an <Association> that uniquely identifies the <ResourceIdentifier> argument."
^aResourceIdentifier owningClass name -> aResourceIdentifier name!
okToSaveOrDeploy
"Private - Prior to saving or deploying the receiver, check that all is consistent and answer whether the
receiver should be saved. Raise Errors that describe any problems."
self isSystemPackage ifTrue: [^false].
self hasCyclicPrerequisites
ifTrue:
[self class unsaveableSignal
signal: ('The package ''%1'' has cyclic prerequisites.' formatWith: self name).
^false].
"N.B. This must be done after the above, as it will go infinitely recursive if there are cycles."
self hasUncommittedPrerequisites
ifTrue:
[self class unsaveableSignal
signal: ('The package ''%1'' has prerequisites which are not currently assigned to any other package, or it is dependent on other packages which in turn have uncommitted prerequisites.'
formatWith: self name).
^false].
self validate.
^true!
okToUninstall
"Private - Validate that the receiver can be uninstalled.
Raise Errors that describe any problems. Answer whether
OK to proceed."
self isSystemPackage ifTrue: [
Error signal: 'The base system package cannot be uninstalled'.
^false].
self hasCyclicPrerequisites ifTrue: [
Error signal: ('The package ''%1'' has cyclic prerequisites and cannot be uninstalled.' formatWith: self name).
^false].
^true!
onClassRemoved: aClass
"Private - React to aClass being removed from the Dolphin system.
Ensure that none of the receivers loaded packages refer to aClass
or its methods now it has departed.
N.B. We have to take care here when checking methods. As aClass is
no longer tied into the system class tree we have to use the method
"Private - The development system is informing us that the user-interface is active, and hence we
should expect to be responding to events as otherwise change flags, and pre-requisites, etc
will not be operating correctly."
self isProcessingEvents
ifFalse:
[((MessageBox new)
taskModal;
yesNo;
warning: 'The package system is not currently monitoring change events. This means that changes may not be detected and flagged, caches are not maintained, and pre-requisites may be incorrect. Change monitoring should normally only be suppressed during lengthy install/uninstall operations. A previous error or debugging session may have left the package manager in an inconsistent state.
Would you like to re-enable change monitoring (recommended)?')
'A PlayShape represent a basic shape that may be added to a <Playground> window and then manipulated with messages. It is part of the Playground sample package and can be used as a Smalltalk learning aid. See this package''s comment for more details.
PlayShape is an abstract class. That is, it does not contain sufficient information or implementation to stand on its own. Only subclasses of PlayShape (such as Square, Circle etc) should ever be created. PlayShape does provides a number of methods that implement basic operations that the subclasses can rely on but they are not, in themselves, complete. For example, the #drawOn: method cannot actually draw the final shape since it does not have enough information. If you accidentally try to create an instance of PlayShape and add it to a Playground then you will receive a walkback describing that "#drawOn: is the responsibility of a subclass". This indicates the abstract nature of the PlayShape class.
Instance Variables:
playground <Playground> or nil owning the shape.
'!
!PlayShape methodsFor!
delay
"Delay for a short period after redrawing. This allows us to see some (very) limited
animation when repeating operations"
Processor sleep: 200
!
drawOn: aCanvas
"Private - Draws the receiver on aCanvas. The PlayShape class does not hold
enough information to describe how a particular shape might be drawn successfully.
This method is therefore the responsibilty of a subclass which provides this additional
behaviour. For this reason we signal a walkback that describes this method as being
the responsibility of a subclass."
self subclassResponsibility!
playground: aPlayground
"Private - Sets the Playground to which the receiver belongs. This information
is used so that the receiver can ask it's playground to redraw whenever any
changes are made to it.
This method should only be called by a Playground when the receiver is added
or removed. It is not intended to be called directly by a user modifying a shape.
Hence it is marked as being private"
playground := aPlayground!
redraw
"Ask for the receiver to be redraw within it's current Playground.
This is normally sent when any significant changes have been made
to the receiver"
playground invalidate; update.
self delay! !
Presenter comment:
'Presenter is an abstract class whose subclasses conform to <presenter> and represent components in the Model-View-Presenter framework. A presenter is the equivalent of a "user interface component" in the Dolphin MVP framework. It achieves flexibility over other component based architectures by allowing its data (its model) and its screen representation (its view) to be pluggable. Thus, one can change the way a user sees and manipulates a component by changing its view and one can change the data that the component is representing by changing the model. Substituting a presenter''s model also allows several presenter and view pairs to share and interact with the same data.
A presenter determines how the user perceives, selects, and performs actions on its model data. Whereas a view is an output device to display model information, a presenter is generally a co-ordinator between actions received in the view and the changes these make to the model. The changes that a presenter makes to its model are normally instigated either by a <commandSource> or by interpreting gestures that the view has received from the user. Such changes are usually applied to a selection of the model''s data that is held by the presenter.
You will find that presenters naturally fall into two camps; those that are generic simple components such as text editors, lists and trees, and those that are specific to application models. Often the more specific presenters are <compositePresenter>s since these can be used to handle simultaneous user interaction with multiple aspects of a model. Note that in contrast to previous versions of Dolphin, in Dolphin 5 both <compositePresenter>s and <presenters> can be subclassed directly off <Presenter> (the old CompositePresenter class has gone and is replaced with a global variable that aliases Presenter).
When implementing any <presenter> the following basic steps should be followed:
1. Decide what sort of presenter is being implemented and, therefore, its position in the class hierarchy. Normally, you will subclass below one of (Presenter, Shell, Dialog, ValueDialog or ValuePresenter). See the comments for these classes to understand more about when to use each type.
2. Implement a #defaultModel class method to answer a default model suitable for the presenter. This model can be superseded as the presenter is instantiated, or replaced later, but it must be available for default instantiations.
3. All presenters inherit a default view resource name of "Default view". It is recommended that if you only intend to have one view onto your presenter then it should be named this in the resource manager. Otherwise, it will be necessary to override the #defaultView class method to answer the actual name of the view resource you wish to use.
4. Next create a view resource for the presenter and associate it with the presenter''s class. This is normally done using the View Composer. The easiest way to create a new view is to write click on the presenter class in the Class Hierarchy Browser and choose the "New view" command. This will launch the View Composer on a copy of the closest "Default view" found for the presenter. If you are designing the default view itself then remember to save it under the name that will be answered by the #defaultView method (see above).
5. Override the #createSchematicWiring method on the instance side in order to "wire up" any event handlers that your presenter might need.
When implementing a <compositePresenter> the following basic steps should be followed (after the steps described above):
1. Add instance variables for each of the sub-presenters that will make up the composite. Often one uses sub-presenters to display/edit different aspects of the model, so you will require one variable for each aspect that is to be "presented"..
2. Implement a #createComponents instance side method. In here, the sub-presenters are created, named, and assigned to the appropriate instance variables. The names that you give them (not the instance variable names) are important since they indicate which sub-views, within the presenter''s associated <compositeView> will get connected to the various sub-presenters.
3. It has been mentioned that the #createSchematicWiring method may need to be overriden to specify appropriate event handling. This is much more likely to be required when creating a <compositePresenter> since you are liable to want to hook up to any events triggered by the sub-presenters and redirect them to specific methods within the new presenter class.
4. The next stage is to set up the models of the sub-presenters. Normally you will do this by overriding #model:. If your sub-presenters are to be used to display aspects of the <compositePresenter>''s model (as is common) then you should use this opportunity to assign appropriate <ValueAspectAdapter>s onto these aspects to them.
Instance Variables:
model <Object> holding the model data that the presenter is to manipulate.
view <view> displaying the model data and supplying UI gestures and commands to the presenter.
parentPresenter <compositePresenter> that is the presenter''s parent or nil if it is a top level shell.
events <EventsCollection> holding the presenter''s event registrations.
subPresenters <OrderedCollection> of sub-presenters.
names <IdentityDictionary> mapping sub-presenter instances to their <readableString> names.
'!
!Presenter class methodsFor!
acceleratorKeyBindings
"Answer a <Dictionary> mapping accelerator key sequences to commands, being the additional accelerator
definitions for commands not on the menu bars (if any) of the receiver's view(s).
N.B. The answer is a copy of the accelerator key bindings, and so modifications will not take effect unless
the dictionary is set back with #acceleratorKeyBindings:"
| answer |
answer := Dictionary new.
self additionalAccelerators do: [:each | answer at: each last put: each first].
^answer!
acceleratorKeyBindings: aDictionary
"Set a collection of additional accelerator definitions for commands not on the menu bar of the receiver's view(s).
The argument should be an <abstractDictionary> mapping accelerator key strings, e.g. 'Ctrl+I' to command name
"This is where the receiver specifies any drag image overrides.
To do this use DragDropSession>>#imageAt: <Symbol> put: <Image> where
the Symbol is an either #object (to specify the underlying icon), or an
operation Symbol such as #none, #move, #copy, #link, #moveScroll, #copyScroll,
#linkScroll or some other Symbol to match an operation symbol. The Image
is any Image (e.g. Icon or Cursor)."
self view requestDragImages: session!
requestDragObjects: session
"This is where the receiver specifies which object(s) the <DragDropSession>, session,
is to drag. The objects are added to the session using DragDropSession>>addDragObject:
or DragDropSession>>dragObjects:."
self view requestDragObjects: session!
requestDropOperations: session
"Update the <DragDropSession>, session, with the set of supported
drag and drop operation symbols (for right-button drags).
Implementation Note: Reflect back to the View, which will (normally)
tigger a #requestDropOperations: event off the receiver."
self view requestDropOperations: session!
setEvents: anEventsCollectionOrNil
"Private - Set the EventsCollection of the receiver to be anEventsCollectionOrNil.
Answer the receiver."
events := anEventsCollectionOrNil!
setFocus
"Sets keyboard input focus to the view associated with the receiver.
First ensure that the view is visible within it's parent"
| v |
v := self view.
v ensureVisible.
v setFocus!
show
"Shows the view of the receiver"
self view show!
showShell
"Shows the Shell to which the receiver belongs"
self view topShell show!
stbSaveOn: anSTBOutFiler
"Output the receiver to anSTBOutFiler. We must ensure that the local events collection
is NOT saved to the filer"
anSTBOutFiler override: events with: nil.
super stbSaveOn: anSTBOutFiler.!
subPresenters
"Answers an OrderedCollection of Presenters that are the
children of the receiver"
^subPresenters!
topShell
"Answer the <topPresenter> associated with the receiver."
| next |
next := self parentPresenter.
next isNil ifTrue: [next := self view].
^next topShell!
validateUserInterface
"Validates the user interface for the receiver. Usually performed at idle time
when the UI has been flagged as being invalid"
self view validateUserInterface!
view
"Answer the view for the receiver. If the view has not yet been created then
it is created now"
^view !
view: aView
"Set the view for the receiver to aView. We also connect up any sub-views
to same named presenters in our subPresenters collection"
self attachSubPresenterViews: aView.
view := aView.
self onViewAvailable.
self connectView!
viewModel
"Private - Answer the model that is to be connected to the view. In general this
is identical to the receiver's model but in some cases the presenter may want to
donate a different model to the view"
^self model! !
ProcessorScheduler comment:
'The singleton instance of ProcessorScheduler (the global, Processor) manages the set of live, ready to run, processes, scheduling the interpreter in a round-robin fashion but in strict priority order.
Processor is the destination for all asynchronous interrupts from the VM, and also manages ''callbacks'' (i.e. invocations of Smalltalk code from external systems, such as the dispatching of windows messages to the window procedure). In particular the Processor ensures that processes return from callbacks in strict LIFO order so that synchronization with the native machine stack is maintained.
Asynchronous interrupts may be delivered to a process at any time including when the process is suspended, e.g. waiting on a Semaphore. The only exceptions are that any interrupts queued to terminated processes are discarded, and that interrupts will not be delivered while asynchronous events are disabled (see #(enable|disable)Interrupts). Interrupts may be sent by the VM to notify of certain conditions, such as the weak loss or finalization queues exceeding their high water marks, but they can also be used to ''inject'' code from one process into another (see Process>>#interruptWith:). A similar mechanism is used when one Process explicitly terminates another (i.e. murder rather than suicide) to inject a terminate signal which is then used to raise an exception caught by a handler at the very base of the Process entry point. This has the effect of running all unwind blocks (set up by #ifCurtailed: and #ensure:) so that a Process can shut down cleanly.
Note that much of the behaviour of the ''processor'' is actually implemented in the process subsystem of the VM. This is partly for performance reasons, and partly because primitives are atomic.
Instance Variables:
processLists <Array> of <LinkedList>s of processes which are ready to run and awaiting scheduling.
activeProcess The <Process> which is currently executing
pendingReturns <Semaphore> on which out-of-order callback exit attempts wait their turn to exit.
comStubs <PermanentRegistry> of currently registered COM server stub object.
Used to map virtual callbacks to their destination object.
overlappedCalls <Semaphore> on which processes engaged in overlapped calls wait for the call to complete.
pendingTerminations <Sempahore> on which processes being terminated wait until any outstanding overlapped calls have been terminated.
Class Variables:
InterruptSelectors <Array> of <Symbol> selectors for each of the interrupt numbers sent by the VM.'!
!ProcessorScheduler class methodsFor!
initialize
"Initialize the receiver's class variables:
InterruptSelectors - Selectors to be sent to the Processor when the corresponding interrupt
number is sent by the VM.
Evaluate me to initialize:
ProcessorScheduler initialize
"
ConstWriteSignal := Signal description: 'Attempt to update read-only object'.
InterruptSelectors :=
#(
terminate: "1"
stackOverflow: "2"
debugBreak: "3"
singleStep: "4"
gpFault: "5"
idlePanic: "6"
interruptWith: "7"
onStartup: "8"
kill: "9"
fpException: "10"
userBreak: "11"
zeroDivide: "12"
otOverflow: "13"
constWrite: "14"
win32Fault: "15"
fpStackFault: "16"
noMemory: "17"
hospiceOverflow: "18"
bereavedOverflow: "19"
unusedInterrupt: "20"
)
!
new
"There can be only one scheduler, and it is stored in the global variable Processor (which
'This class forms part of a tutorial for the Dolphin Beginner''s Guide. A Question represents a decision node in the animal guessing game. Question instances form the branch nodes in the game''s knowledge tree. Each instance contains the text of a question and a yes/no branch to take depending on the result of that question. These branches can either point to other Question nodes or to an Animal node if this is a leaf in the tree. '!
!Question class methodsFor!
promptToDistinguish: anOldAnimal from: aNewAnimal
"Answers an instance of the receiver (a Question) that will distinguish between
anOldAnimal and aNewAnimal. The question should be phrased such that the
"Answer an instance of the receiver (a Question) having aString as it's text and
leading to the nodes at yesPath and noPath as the result of those answers to its
question."
^self new text: aString yes: yesPath no: noPath
! !
!Question methodsFor!
ask
"Ask the receiver's question and continue the game appropriately depending on the
answer that is received"
(MessageBox confirm: self displayString caption: 'The animal you''re thinking of...')
ifTrue: [ self yes ask ]
ifFalse: [ self no ask ].!
displayOn: aStream
"Answer the name of the receiver as a user should see it. For this
we append a question mark."
aStream nextPutAll: self text; nextPutAll: ' ?'.!
no
"Answer the branch in the knowledge tree to take as the result of a 'no' answer
to the receiver's question."
^no!
printOn: aStream
"Answer the name of the receiver as a developer would wish
to see it."
super printOn: aStream.
aStream nextPut: $(.
self displayOn: aStream.
aStream nextPut: $).!
text
"Answer the receiver's question as a text String"
^text!
text: aString yes: yesPath no: noPath
"Private - Set the text of the receiver to aString and the yes and no branches to
yesPath and noPath respectively. This is a bit tricky. At the end of this operation
we want the receiver to have completely swapped its identity with the original
noPath. This is a bit of a kludge (since there are better ways to insert the receiver
in the knowledge tree at the right point) but it is the simplest solution for this
example program."
text := aString.
yes := yesPath.
no := self.
self become: noPath!
yes
"Answer the branch in the knowledge tree to take as the result of a 'yes' answer
to the receiver's question."
^yes! !
Rectangle comment:
'Instances of Rectangle represent a rectangular areas in a two dimensional Cartesian coordinate system. A Rectangle contains two Points; origin, which specifies the top left corner, and corner, which indicates the bottom right corner of the region described.
A Rectangle is typically created by sending the method #corner: to an instance of Point, although a number of other instance creation class methods are also provided:
100@100 corner: 150@150
Rectangles inhabit the same Smalltalk standard "left-handed" coordinate system as do Points; i.e. with the y axis increasing downwards. Because of this, in a non-empty Rectangle, the origin is always expected to be above and to the left of the corner. Rectangles that are not in this normalised state can be sent the message #normalize to answer a copy that is. Many of the operation messages on Rectangles will assume that the receiver is normalised.
(150@150 corner: 100@100) normalize'!
!Rectangle class methodsFor!
center: aPoint extent: aPointExtent
"Answer an instance of the receiver of aPointExtent centred on aPoint"
"Answer the receiver in a form suitable for passing to an external
library call. In this case we unwrap."
^self rtf!
asRichText
"Answers the receiver as RichText"
^self!
asString
"Answers the receiver as a String containing plain text"
| converter string |
converter := self class rtfConverter.
converter rtfText: self rtf.
string := converter plainText.
converter setWindowText: ''.
^string!
copyToClipboard
"Private - Copy a format of the receiver to the clipboard."
Clipboard current setText: self format: #RichText!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: self asString!
displayString
"Answer a String whose characters are a representation of the receiver as a user
would want to see it"
^self asString displayString!
hash
"Answer the <integer> hash value for the receiver."
^self rtf hash!
isEmpty
"Answer whether the receiver contains no text."
^false!
notEmpty
"Answer whether the receiver contains any text."
^true!
printOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver
as a programmer would want to see it."
aStream
basicPrint: self;
nextPutAll: self rtf!
replaceSelectionIn: aTextEdit
"Sent as part of a double dispatch from View objects to set their selection text from
the receiver. The RichText protocol requires that aTextEdit must implement both #selectionPlainText:
and #selectionRichText: methods."
aTextEdit selectionRichText: self!
rtf
"Private - Answers the receiver's RTF contents"
^rtf!
rtf: anRtfString
"Private - Sets the receiver to contain the RTF text in anRtfString"
rtf := anRtfString!
setTextInto: aView
"Sent as part of a double dispatch from View objects to set their text from
the receiver. The receiver is assumed to be rich text, so sends the #richText
message back to aView."
aView richText: self! !
SearchPolicy comment:
'SearchPolicy is for configuring pluggable collections and models to use different searching policies, e.g. equality vs. identity. SearchPolicy itself implements an equality based policy using #= and #hash, etc.
SearchPolicy is the canonical implementation of the <searchPolicy> and <comparisonPolicy> protocols (the latter is really a subset of the former).
The <comparisonPolicy> protocol can be used to compare two objects in order to determine if they are the "same". Different comparison policies can be employed which, for example, consider that two objects are the same iff they are the exact same identical object (i.e. ''''obj1 == obj2'''' is true), or on the other hand if they are of equal value (i.e. ''''obj1 = obj2'''' is true).
SearchPolicy maintains a number of prebuilt instances which implement popular search/comparison policies. These are accessible via class side methods in the ''''instance creation'''' category.
Class Variables:
Always <AlwaysSearchPolicy>. Maintains that two objects are always equal.
Identity <IdentitySearchPolicy>. Singleton instance for identity searching.
Equality <SearchPolicy>. Singleton instance for equality searching.
Never <NeverSearchPolicy>. Maintains that two objects are never equal.
'!
!SearchPolicy class methodsFor!
always
"Answers the singleton instance of the receiver that always answers
true to #compare:with: (i.e. under this comparison policy two objects
'This class implements the Secure Hash Algorithm (SHA) described in the U.S. government''s Secure Hash Standard (SHS).
This standard is described in FIPS PUB 180-1, "SECURE HASH STANDARD", April 17, 1995. The Secure Hash Algorithm is also described on p. 442 of ''Applied Cryptography: Protocols, Algorithms, and Source Code in C'' by Bruce Scheier, Wiley, 1996.'!
'SessionManager is the class of objects responsible for managing the lifecyle of an application, from startup to shutdown. SessionManagers are also responsible for determining the global policy for dealing with unhandled Exceptions.
SessionManager itself is abstract, with two further abstract subclasses that divide applications into two groups: <ConsoleSessionManager> whose subclasses implement Console (that is, command line, DOS style) applications, and <GUISessionManager> whose subclasses implement GUI (that is, Windows) applications.
When you come to deploy an application, you will probably need to write a SessionManager for it, although it is possible to do without (see the ADK documentation). In the case of a console application you should subclass <ConsoleSessionManager>, and in the case of a GUI application you should typically subclass <RuntimeSessionManager>. To get going it is only necessary to implement a #main method which either implements the main body of the application (in the case of simple console apps), or which invokes it by creating an instance of some other class, passing it appropriate arguments drawn from the #argv collection which is a collection of the components that formed the original command which started the application.
Instance Variables:
inputState <InputState>. Implements the Windows message loop (even console apps have one in Dolphin).
"Answer the number of objects currently in the queue"
^accessProtect critical: [contents size]! !
Signal comment:
''!
!Signal class methodsFor!
description: anObject
"Answer a new, non-resumable, instance of the receiver with the specified description"
^self new description: anObject!
icon
"Answers an Icon that can be used to represent this class"
^Error icon!
new
"Answer a new correctly initialize instance of the receiver."
^super new initialize!
resumableDescription: anObject
"Answer a new continuable instance of the receiver with the specified description."
^self new
description: anObject;
makeResumable! !
!Signal methodsFor!
, arg
"Answer a new <ExceptionSet> containing the receiver and the argument."
^ExceptionSet with: self with: arg!
defaultAction: exception
"Private - Perform the default action for the raised incarnation of the receiver,
exception, as it has not been handled.
Implementation Note: forward to the SessionManager for application specific handling."
"Will not return unless execution is to be resumed"
^SessionManager current onUnhandledError: exception!
defaultResumption
"Private - Answer the default setting for the receiver's resumable flag."
^false!
description
"Private - Answer the receiver's description format string."
^description!
description: aString
"Set the description of the receiver to be aString. The description can include
Win32 format substitution specifiers."
description := aString!
exceptionClass
"Private - Answer the class of Exception to be raised when the receiver
is signalled."
^RaisedSignal!
handles: exception
"Answer whether the receiver matches the <exceptionDescription>, exception, and
any handler at this scope should be invoked."
^exception signalType == self
!
initialize
"Private - Initialize the receiver's instance variables."
resumable := self defaultResumption.
description := '%1'!
isResumable
"Answer whether the receiver represents a resumable Signal."
^resumable!
makeNonResumable
"Make the receiver a non-resumable Signal. Answer the receiver."
resumable := false!
makeResumable
"Make the receiver a resumable Signal. Answer the receiver."
resumable := true!
newException
"Answer a new <Exception> instantiated on the receiver, but as yet unsignalled."
^self exceptionClass new
signalType: self;
yourself!
printOn: aStream
"Append a short textual description of the receiver to aStream."
aStream
basicPrint: self;
nextPut: $(;
print: self description;
nextPut: $)
!
resumable: aBoolean
"Set whether the receiver represents a resumable Signal."
resumable := aBoolean!
signal
"Signal the occurrence of an exceptional condition.
This method will not normally return to its sender.
Implementation Note: A new <Exception> is instantiated and
signalled, initiating a search for an ExceptionHandler prepared to
handle that exception."
^self newException signal!
signal: signalerText
"Signal the occurrence of an exceptional condition with the specified description.
This method will not normally return to its sender.
N.B. X3J20 requires that the argument, signalDescription, conform to the
<readableString> protocol, but we relax this to permit an object (which is sent
#displayString to get a <readableString>).
Portable code should use only <readableString> descriptions.
Implementation Note: Raise a new <Exception> instance with the specified details,
initiating a search for an ExceptionHandler prepared to handle that exception."
^self newException signal: signalerText!
signal: signalerText with: signalerTag
"Signal the occurrence of an exceptional condition with the specified description
and tag. This method will not normally return to its sender."
^self newException
signal: signalerText
with: signalerTag
!
signalWith: signalerTag
"Signal the occurrence of an exceptional condition with the specified tag object.
This method will not normally return to its sender."
^self newException signalWith: signalerTag! !
SmalltalkParser comment:
'Instance Variables:
scanner <SmalltalkScanner>
currentToken <StToken>
nextToken <StToken>
emptyStatements <boolean>
errorBlock <dyadicValuable>
source <readableString>
methodClass <Class>|<Metaclass>
methodNode <StMethodNode>
Class Variables:
ExternalValueTypes <LookupTable>. Maps standard external type names, as recognised by the old Dolphin Compiler to the parameter types to be used for passing by value and by reference.
ExternalReferenceTypes <Array> of <integer>|<Symbol>. Reference types corresponding to the <integer> external value types.
ExternalCallingConventions <Array> of <String>. External calling convention keywords (e.g. ''cdecl:'').
MaxPrimIndex <integer>. Maximum primitive number.
MaxVfn <integer>. Maximum virtual function number.
'!
!SmalltalkParser class methodsFor!
initialize
"Private - Initialize the receiver's class variables.
SmalltalkParser initialize
"
MaxPrimIndex := 192.
MaxVfn := 1024.
ExternalValueTypes := LookupTable new.
ExternalValueTypes
at: 'sdword' put: ExtCallArgSDWORD;
at: 'dword' put: ExtCallArgDWORD;
at: 'lpvoid' put: ExtCallArgLPVOID;
at: 'handle' put: ExtCallArgHANDLE;
at: 'lppvoid' put: ExtCallArgLPPVOID;
at: 'lpstr' put: ExtCallArgLPSTR;
at: 'bool' put: ExtCallArgBOOL;
at: 'double' put: ExtCallArgDOUBLE;
at: 'float' put: ExtCallArgFLOAT;
at: 'hresult' put: ExtCallArgHRESULT;
at: 'char' put: ExtCallArgCHAR;
at: 'byte' put: ExtCallArgBYTE;
at: 'sbyte' put: ExtCallArgSBYTE;
at: 'word' put: ExtCallArgWORD;
at: 'sword' put: ExtCallArgSWORD;
at: 'oop' put: ExtCallArgOOP;
at: 'lpwstr' put: ExtCallArgLPWSTR;
at: 'bstr' put: ExtCallArgBSTR;
at: 'qword' put: ExtCallArgQWORD;
at: 'sqword' put: ExtCallArgSQWORD;
at: 'ote' put: ExtCallArgOTE;
at: 'variant' put: ExtCallArgVARIANT;
at: 'varbool' put: ExtCallArgVARBOOL;
at: 'guid' put: ExtCallArgGUID;
at: 'date' put: ExtCallArgDATE.
"void is only valid as a return type, not an argument type."
'SmalltalkScanner is the Smalltalk lexical analyzer. It converts source text to a stream of <StToken>''s.
Note that SmalltalkScanner is based on the RBScanner class written by John Brant and Don Roberts for their Refactoring Browser. It has been extended for Dolphin to incorporate additional error reporting capabilities (such as the line number on which the error occurred), and the ability to parse Dolphin''s FFI call syntax.
WARNING: If you do this you will lose the source of all changes since the
last #compressSources."
mutex critical:
[| chgFile |
chgFile := self changesFileName.
self closeChangesFile.
(FileStream write: chgFile) close. "truncate it"
self openChangesFile: chgFile]! !
StackFrame comment:
'StackFrame encapsulates behaviour of an activation record for use by the development tools (especially the debugger) and other reflective activities. A StackFrame is only valid as a snapshot of Process state (e.g. when the process is suspended, as it is when being debugged).
Dolphin''s activation records are not objects (in fact they are just range of slots in the Process stack), and so this class is employed to stand in and wrap those records.
The layout of a stack frame is:
Calling stack frame address
Instruction Pointer (offset into methods byte codes)
Stack Pointer (address in Process stack)
Method (CompiledCode subinstance)
Base Pointer (address of arguments, which preceed the stack frame, or reference to MethodContext)
An activations arguments and receiver preceed the frame, with the arguments being pointed at by the frames BP (unless it is has an associated MethodContext due to the method having full blocks). The receiver is at BP-1, with arguments at BP+0..BP+n-1, where n is the number of arguments.
An activations temporary variables immediately succeed the frame, with working stack space on top of those.'!
!StackFrame class methodsFor!
frameClassFor: aProcess at: anInteger
"Private - Answer the subclass of the receiver to use to represent a stack frame in aProcess
at the specified index."
| base |
base := aProcess at: anInteger + BaseOffset ifAbsent: [^nil].
^base isInteger
ifTrue: [self]
ifFalse: [
base isNil
ifTrue: [ContextFrame]
ifFalse: [base frameClass]]
!
initialize
"Initialize the class variables of the receiver."
ReturnOffset := 0.
IPOffset := 1.
SPOffset := 2.
MethodOffset := 3.
BaseOffset := 4.
FrameSize := BaseOffset + 1!
process: aProcess index: anInteger
"Private - Answer a new instance of the receiver representing the stack frame in aProcess
at the specified index in aProcess, or nil if the specified index is out of bounds in the process."
"Private - Answer the signature that identifies the data as
being in Smalltalk Binary (STB) format."
^##('!!STB ' asByteArray)
!
version
"Private - Answer the version number of the format produced by the receiver."
^1
! !
!STBFiler methodsFor!
atEnd
"Answer true if the receiver is positioned at end of its stream."
^stream atEnd
!
context
"Answers the context for objects read by the receiver"
^context!
context: anObject
"Sets the context for objects read by the receiver to anObject. This may be,
for example, the parent window of a window being read."
context := anObject!
initialize
version isNil ifTrue: [version := self class version].
self reset.
^self!
position: anInteger
"Position the receiver's stream to anInteger, read/write a header at this
place and prepare it for a new input or output session."
stream position: anInteger.
self reset.!
reset
"Private - Reset the instance.
We pre-register objects that must never be recreated - note that if the 'fixed' list of pre-registered
objects is changed, then the STB version must be changed and the old versions handled
appropriately."
self
register: true;
register: false;
register: Smalltalk;
register: Processor.
version > 0
ifTrue:
["Also register some commonly used classes so:
a) It is possible to binary file the classes STBClassProxy and String; and
b) we don't need to file these out all the time so can save some space.
Note that pre-registering classes does not inflate the size of the binary file,
it just pre-allocates a range of indices for fixed uses.
N.B. Changing the order of these (or deleting registrations) will break existing
binary files"
self
register: String;
register: Array;
register: ByteArray;
register: LargeInteger;
register: STBClassProxy;
register: STBMetaclassProxy;
register: STBSymbolProxy;
register: STBCollectionProxy;
register: OrderedCollection;
register: STBIdentityDictionaryProxy;
register: LookupTable;
register: IdentityDictionary.
self setRefOffset: 24]!
setRefOffset: anInteger
^self subclassResponsibility!
stream
"Answer the stream to which the receiver is attached."
^stream!
stream: aStream
"Set stream to aStream."
stream := aStream!
version
^version!
version: anInteger
version := anInteger! !
STBPrefix comment:
'STBPrefix represents the object prefix encoding used in an STB binary file stream. It encapsulates much of the complexity of the data encoding performed by the STBOutFiler and STBInFiler classes. As the data encoding has been designed to achieve a reasonably compact format there are some restrictions on the order in which the methods can be called.
Instance Variables:
dword The actual 32-bit <Integer> encoding
Pools:
STBPrefixConstants <PoolConstantsDictionary> containing bit masks for testing the encoding.
The encodings are as follows (this is best viewed in a non-proportional font):
SSSSSSSS SSSSSSSS SSSSSSSS SSSSSS11 a SmallInteger
RRRRRRRR RRRRRRRR RRRRRRRR RRRR0000 an Object Reference
RRRRRRRR RRRRRRRR RRRRRRRR RRRR0010 a Class Reference (Non-proxy object)
???????? ????CCCC CCCCCCCC CCCC0100 a Character
LLLLLLLL LLLLLLLL IIIIIIII ?NVB0110 an Initial Class prefix (to Non-proxy object)
???????? ???????? ???????? ????1000 RESERVED
RRRRRRRR RRRRRRRR RRRRRRRR RRRR1010 a Class Reference (Proxy object)
???????? ???????? ???????? ????1100 RESERVED
LLLLLLLL LLLLLLLL IIIIIIII ?NVB1110 an Initial Class prefix (to Proxy object)
|||||||
|||||| --> isSmallInteger
||||| ---> isDataPrefix
|||| ----> isClassPrefix
||| -----> isProxy
|| ------> isBytes
| -------> isVariable
--------> isNonZeroVersion
0SSSSSSS SSSSSSSS SSSSSSSS SSSSSSS1 -> 30 bit SmallInteger value (low bit always 1)
00000000 00000000 CCCCCCCC CCCCCCCC -> 16 bit Charater value
0000RRRR RRRRRRRR RRRRRRRR RRRRRRRR -> 28 bit Reference index
00000000 00000000 LLLLLLLL LLLLLLLL -> 16 bit Class name length
00000000 00000000 00000000 IIIIIIII -> 8 bit Instance size
When testing an instance of this class the tests should be performed in the following order.
anSTBPrefix isSmallInteger
ifTrue: [^anSTBPrefix smallInteger. to yeild the SmallInteger represented.]
ifFalse: [
anSTBPrefix isDataPrefix
ifFalse: [
anSTBPrefix isCharacter
ifTrue: [^anSTBPrefix character]
ifFalse: [^anSTBPrefix refIndex. to answer the index of an already loaded object.]]
ifTrue: [
The data of the object represented will follow the prefix (although perhaps not immediately).
anSTBPrefix isClassPrefix
ifFalse: [
anSTBPrefix refIndex. is the index of the class of the object represented.
The data of the object represented follows the prefix.]
ifTrue: [
anSTBPrefix isNonZeroVersion
ifTrue: [The integer following the prefix is the version of the class of the object represented].
anSTBPrefix classLocatorLen. is the number of following bytes containing the name
of the class of the object represented.
anSTBPrefix instSize. This is the instance size of the class of the object represented.
anSTBPrefix isBytes
ifTrue: [The class of the object represented is made of bytes].
anSTBPrefix isVariable
ifTrue: [The class of the object represented is indexable]].
anSTBPrefix isProxy
ifTrue: [
The object represented is a proxy for the real one and should be sent a #fixup:at: message
to yeild the real object]]]."'!
!STBPrefix class methodsFor!
forCharacter: aCharacter
"Answer a new instance to prefix aCharacter."
^self new
character: aCharacter;
yourself!
forData
"Answer a newly initialised instance to prefix a data object."
^self fromInteger: DataPrefixMask!
forObjectRef: anInteger
"Answer a new instance to prefix an object that has already been output."
^self new
objectRef: anInteger;
yourself!
forProxy
"Answer a newly initialised instance to prefix a proxy object."
^self forData
beProxy;
yourself!
forSmallInteger: aSmallInteger
"Answer a new instance to prefix aSmallInteger."
^self new
smallInteger: aSmallInteger;
yourself!
fromInteger: anInteger
"Answer a new instance initialise from anInteger."
^self new
dword: anInteger! !
!STBPrefix methodsFor!
beDataPrefix
"Set the receiver's isDataPrefix bit flag."
dword := dword bitOr: DataPrefixMask!
beProxy
"Set the receiver's isProxy bit flag."
dword := dword bitOr: ProxyMask!
character
"Answer the Character represented by the receiver."
^Character value: (dword bitShift: IndexShift)!
character: aCharacter
"Make the receiver a prefix to a 'virtual' Character, virtual because
as we encode aCharacter's value entirely within the prefix no object data need follow."
'StProgramNode is an abstract class that represents a parse tree node in a Smalltalk program.
Subclasses must implement the following messages:
accessing
start
stop
visitor
acceptVisitor:
The #start and #stop methods are used to find the source that corresponds to this node. "source copyFrom: self start to: self stop" should return the source for this node.
The #acceptVisitor: method is used by StProgramNodeVisitors (the visitor pattern). This will also require updating all the StProgramNodeVisitors so that they can handle the new node type.
Subclasses might also want to redefine #match:inContext: and #copyInContext: to do parse tree searching and replacing (these methods are only available if the RBParser extension package is loaded).
Subclasses that contain other nodes should override equalTo:withMapping: to compare nodes while ignoring renaming temporary variables, and children that returns a collection of our children nodes.
Instance Variables:
comments <Collection> of <Interval> the intervals in the source that have comments for this node
parent <StProgramNode> the node we''re contained in
'A TestCase is a Command representing the future running of a test case. Create one with the class method #selector: aSymbol, passing the name of the method to be run when the test case runs.
When you discover a new fixture, subclass TestCase, declare instance variables for the objects in the fixture, override #setUp to initialize the variables, and possibly override# tearDown to deallocate any external resources allocated in #setUp.
When you are writing a test case method, send #assert: aBoolean when you want to check for an expected value. For example, you might say "self assert: socket isOpen" to test whether or not a socket is open at a point in a test.'!
inject: (self suiteClass named: self name asString)
into: [:suite :selector |
suite
addTest: (self selector: selector);
yourself]
!
buildSuiteFromSelectors
^self shouldInheritSelectors
ifTrue: [self buildSuiteFromAllSelectors]
ifFalse: [self buildSuiteFromLocalSelectors]
!
debug: aSymbol
^(self selector: aSymbol) debug
!
isAbstract
"Override to true if a TestCase subclass is Abstract and should not have
TestCase instances built from it"
^self sunitName = #TestCase
!
resources
^#()
!
run: aSymbol
^(self selector: aSymbol) run
!
selector: aSymbol
^self new setTestSelector: aSymbol
!
shouldInheritSelectors
"I should inherit from an Abstract superclass but not from a concrete one by default, unless I have no testSelectors in which case I must be expecting to inherit them from my superclass. If a test case with selectors wants to inherit selectors from a concrete superclass, override this to true in that subclass."
"Override to true if a TestResource subclass is Abstract and should not have
TestCase instances built from it"
^self sunitName = #TestResource
!
isAvailable
^self current notNil and: [self current isAvailable]
!
isUnavailable
^self isAvailable not
!
new
^super new initialize
!
onPreStripImage
self allSubclassesDo: [:each | each reset]!
reset
current notNil ifTrue: [
[current tearDown] ensure: [
current := nil]]
!
resources
^#()
!
signalInitializationError
^TestResult signalErrorWith: 'Resource ' , self name , ' could not be initialized'
! !
!TestResource methodsFor!
canBrowse
^true!
description
description isNil
ifTrue: [^''].
^description
!
description: aString
description := aString
!
displayName
^self name sunitbAsProperNouns!
initialize
self setUp
!
isAvailable
"override to provide information on the
readiness of the resource"
^true
!
isUnavailable
"override to provide information on the
readiness of the resource"
^self isAvailable not
!
name
name isNil
ifTrue: [^self printString].
^name
!
name: aString
name := aString
!
printOn: aStream
aStream nextPutAll: self class printString
!
resources
^self class resources
!
setUp
"Does nothing. Subclasses should override this
to initialize their resource"
!
signalInitializationError
^self class signalInitializationError
!
tearDown
"Does nothing. Subclasses should override this
to tear down their resource"
! !
TestResult comment:
'This is a Collecting Parameter for the running of a bunch of tests. TestResult is an interesting object to subclass or substitute. #runCase: is the external protocol you need to reproduce. Kent has seen TestResults that recorded coverage information and that sent email when they were done.'!
'A <TypeConverter> is capable of converting one type of object into another and vice versa. Very often a TypeConverter forms part of a <ValueConverter> model that sits between a subject value and some client of that value. The subject value is referred to as the ''left'' value and the value the client sees is the ''right'' value. In a typical usage (within the MVP framework) the ''left'' type is the type of the Model value, and the right type is the display value (usually a String).
TypeConverter is itself an abstract class and concrete subclasses must be created to provide specific type convertions. Subclasses should implement #leftToRight: and #rightToLeft: methods to perform the conversions. These methods are, however, private. The public interface for conversion is as defined in the <typeConverter> method protocol.
In order that these seletor names hold a common meaning all subclasses should follow the naming convention LefttypeToRighttype (e.g. NumberToString).
TypeConverters support the notion of an undefined or null value for both left and right value types. The ''null'' value for one side is mapped to the ''null'' value for the other side and vice versa, without going through the normal conversion process. For example text converters will map nil from the left subject value to the empty string display value.
Instance Variables:
leftNullValue <Object> or nil, to which the right null value is mapped by a right to left conversion.
rightNullValue <Object> or nil, to which the left null value is mapped by a left to right conversion.
'!
!TypeConverter class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Answer a new instance of the receiver. Instances require initialization"
^super new initialize!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect name: #leftNullValue);
add: (Aspect name: #rightNullValue);
yourself! !
!TypeConverter methodsFor!
convertFromLeftToRight: anObject
"Converts the <Object> argument, which is assumed to be of the receivers left type
(possibly its null value) to an <Object> of the receiver's right type (possibly its null
"Answers a type converter that reverses the direction of the receiver's conversion.
In this case answers an instance of InvertingConverter that wraps the receiver"
^InvertingConverter inverting: self
!
isLeftNullValue: anObject
"Private - Answers whether the argument can be considered the 'null' value
for the left hand side value type."
^anObject = self leftNullValue!
isRightNullValue: anObject
"Private - Answers whether the argument can be considered the 'null' value
for the left hand side value type."
^anObject = self rightNullValue!
leftExceptionalValue
#deprecated.
^self leftNullValue!
leftExceptionalValue: anObject
#deprecated.
^self leftNullValue: anObject!
leftNullValue
"Answer the 'null' value of the left type."
^leftNullValue!
leftNullValue: anObject
"Set the 'null' value of the left type to the argument."
leftNullValue := anObject!
leftToRight: anObject
"Private - Converts the <Object> argument, which is assumed to be of the receivers left
type to an <Object> of the receiver's right type. Answers the result of the conversion.
Must be overridden by subclasses to perform specific conversions."
^self subclassResponsibility!
rightExceptionalValue
#deprecated.
^self rightNullValue!
rightExceptionalValue: anObject
#deprecated.
^self rightNullValue: anObject!
rightNullValue
"Answer the 'null' value of the right type."
^rightNullValue!
rightNullValue: anObject
"Set the 'null' value of the right type to the argument."
rightNullValue := anObject!
rightToLeft: anObject
"Private - Converts the <Object> argument, which is assumed to be of the receivers right
type to an <Object> of the receivers left type. Answers the result of the conversion.
Must be overridden by subclasses to perform specific conversions"
^self subclassResponsibility! !
UndefinedObject comment:
'UndefinedObject is the singleton class of the distinguished object, <nil>.
<nil> is the initial value of all new variables (instance or otherwise), and hence a primary purpose of UndefinedObject is to provide a means of detecting errors, especially those resulting from the failure to correctly initialize variables.
<nil> is also useful for explicitly representing a null value, e.g. in a variable which has no value. A common use of this type is in conjunction with lazy initialization. In this respect <nil> has a similar purpose to the SQL <null> value.
When interfacing to external functions, etc, <nil> is treated as the null pointer, or zero, as appropriate to the parameter type.
UndefinedObject implements the following ANSI protocols:
<Object>
<nil>'!
!UndefinedObject class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
"Answer the <integer> major version number of the product."
^self fixedInfo dwProductVersionMS!
productMinor
"Answer the <integer> minor version number of the product."
^self fixedInfo dwProductVersionLS!
productName
"Answer the <readableString> product name from the receiver."
^self at: 'ProductName'!
productVersionString
"Answer a String in the form N.N.N.N which specifies the version number of the product."
^self fixedInfo productVersionString!
queryValue: name into: buf
"Private - Get the language/code-page id from the version info block."
| dwLen |
dwLen := DWORDBytes fromInteger: 123.
VersionLibrary default verQueryValue: fileInfo lpSubBlock: name lplpBuffer: buf puLen: dwLen.
^dwLen asInteger!
specialBuild
"Answer the <readableString> product name from the receiver."
^self at: 'SpecialBuild'! !
VideoLibrary comment:
'VideoLibrary is represents a collection of VideoTapes that belong to a particular owner. This class is part of the Video Library sample package. Please see the package comment for more details.'!
!VideoLibrary class methodsFor!
default
"Answer the default instance of the receiver."
DefaultInstance isNil ifTrue: [
DefaultInstance := self new ].
^DefaultInstance !
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Answer a new, initialised, instance of the receiver.
Illustrated Patterns:
Instance Initialization
"
^super new initialize!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
DefaultInstance := nil! !
!VideoLibrary methodsFor!
defaultOwner
"Private - Answer a <readableString> to use as the owner identifier for a default instance.
Illustrated Patterns:
Constant Access Method
Private Method
"
^'My Video Collection'!
displayOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a user
would want to see it."
aStream
display: self owner;
nextPutAll: ', ';
display: self tapes size;
nextPutAll: ' tapes'
!
initialize
"Private - Initialize the receiver to contain default values.
Illustrated Patterns
Instance Initialization
"
tapes := OrderedCollection new.
owner := self defaultOwner.!
owner
"Answer the <readableString> owner name of the receiver.
Illustrated Patterns:
Accessor Method"
^owner!
owner: ownerName
"Initialize the receiver with the <readableString> ownerName
Illustrated Patterns:
Accessor Method"
owner := ownerName.
!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a developer
would want to see it."
self basicPrintOn: aStream.
aStream
nextPut: $(;
display: self;
nextPut: $)
!
tapes
"Answer the <collection> of tapes held by the receiver.
Illustrated Patterns
Accessor Method
"
^tapes! !
VideoRecording comment:
'VideoRecording is represents a programme recorded on a VideoTape. This class is part of the Video Library sample package. Please see the package comment for more details.'!
!VideoRecording class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Answer a new, initialised, instance of the receiver.
Illustrated Patterns:
Instance Initialization
"
^super new initialize! !
!VideoRecording methodsFor!
date
"Answer the <Date> date when the receiver was aired.
Illustrated Patterns:
Accessor Method"
^date!
date: recordingDate
"Set the date of airing of the receiver to <Date> recordingDate.
Illustrated Patterns:
Accessor Method"
date := recordingDate!
defaultLength
"Private - Answer the default length the receiver in minutes.
Illustrated Patterns:
Constant Access Method
Private Method
"
^30!
defaultTitle
"Private - Answer a default title to use for the receiver when none other is provided.
Illustrated Patterns:
Constant Access Method
Private Method
"
^'<Untitled Recording>'!
displayOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a user
would want to see it."
aStream
display: self title;
nextPutAll: ' on ';
display: self date;
nextPutAll: ' at ';
display: self time;
nextPutAll: ' duration ';
display: self length;
nextPutAll: 'min'
!
initialize
"Private - Initialize the receiver to contain default values.
Illustrated Patterns
Instance Initialization
"
self
title: self defaultTitle;
date: Date today;
time: Time now;
length: self defaultLength!
length
"Answer the <Integer> length of the receiver in minutes.
Illustrated Patterns:
Accessor Method"
^length!
length: lengthInMinutes
"Set the duration of the receiver to <Integer> lengthInMinutes.
Illustrated Patterns:
Accessor Method"
length := lengthInMinutes!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a developer
would want to see it."
self basicPrintOn: aStream.
aStream
nextPut: $(;
display: self;
nextPut: $)
!
time
"Answer the <Time> time when the receiver was aired.
Illustrated Patterns:
Accessor Method"
^time!
time: recordingTime
"Set the time of airing of the receiver to <Time> recordingTime.
Illustrated Patterns:
Accessor Method"
time := recordingTime!
title
"Answer the <readableString> title of the receiver.
Illustrated Patterns:
Accessor Method"
^title!
title: titleString
"Set the title of the receiver to <readableString> titleString.
Illustrated Patterns:
Accessor Method"
title := titleString! !
VideoTape comment:
'A VideoTape represents a collection of VideoRecordings recorded on a named video cassette. This class is part of the Video Library sample package. Please see the package comment for more details.'!
!VideoTape class methodsFor!
defaultTapeLength
"Private - Answer a default length (in minutes) to use for instances of the receiver.
Illustrated Patterns:
Constant Access Method
Private Method
"
^240!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
name: tapeName
"Answers an instance of the receiver with the <readableString> tapeName and
a default tape length.
Illustrated Patterns:
Instance Creation Method"
^super new name: tapeName length: self defaultTapeLength
!
name: tapeName length: tapeLength
"Answers an instance of the receiver with the <readableString> tapeName and
the <Integer> length in minutes.
Illustrated Patterns:
Instance Creation Method"
^super new name: tapeName length: tapeLength
! !
!VideoTape methodsFor!
displayOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a user
would want to see it."
aStream
display: self name;
nextPutAll: ' E';
display: self length
!
length
"Answer the <Integer> length in minutes of the receiver.
Illustrated Patterns
Accessor Method
"
^length!
name
"Answer the <readableString> name of the receiver.
Illustrated Patterns
Accessor Method
"
^name!
name: tapeName length: tapeLength
"Private - Initialize the receiver with the <readableString> tapeName and
the <Integer> length in minutes.
Illustrated Patterns:
Instance Variable Role
Private Method
"
name := tapeName.
length := tapeLength.
recordings := OrderedCollection new.!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a developer
would want to see it."
self basicPrintOn: aStream.
aStream
nextPut: $(;
display: self;
nextPut: $)
!
recordings
"Answer the <collection> of recordings held by the receiver.
Illustrated Patterns
Accessor Method
"
^recordings! !
View comment:
'View is an abstract class which is the root of the view hierarchy of classes. Instances of view or its subclasses are used to display Model data in windows. View is part of the Model-View-Presenter or MVP framework:
Views are used in conjunction with <model> and <presenter> objects. Model objects are used to hold application data, and the view''s responsibility is to display this data on the screen. Models usually trigger change notification to ensure that the view is kept up-to-date with the current state of their data. Presenter objects sit between the view and the model and negotiate how changes made in the view should be applied to the model.
Instance Variables:
handle <ExternalHandle> for the view''s window held by MS Windows.
creationParent <compositeView> which is the parent of the view.
creationStyle <Array> of two elements holding the window''s WS_xxx and WS_EX_xxx styles..
presenter <presenter> used for negotiating changes to the view''s model.
model <Object> holding the view''s data.
backcolor <color> for the explicit view background or nil for the default,
preferredExtent <Point> specifying an explicit preferred extent or nil for none..
flags <integer> holding various <boolean> flags.
contextMenu <Menu> a pop-up context menu or nil if none.
'ViewState is capable of holding the relevant state of any <view> so that it may be restored to the same state at a later date. Normally, a ViewState is used during an image save to capture the state of all of the open views so that they may be restored when the image is restarted, but it is also used when dynamic recreation of a view is required such as when changing certainWindow styles that may only be applied when a Window is created.
Instance Variables
view <view> whose state has been saved.
state <monadicValuable>
placement
subViewStates'!
!ViewState class methodsFor!
new
"Private - Use #recordStateOf:"
^self shouldNotImplement!
recordStateOf: aView forRecreate: aBoolean
"Answer an instance of the receiver holding current state information about
aView. This will allow aView's handle to be rebuilt when #restore is sent
to this instance."
^super new
recordStateOf: aView forRecreate: aBoolean! !
!ViewState methodsFor!
recordStateOf: aView forRecreate: aBoolean
"Private - Initialize the receiver so that it is capable of restoring
the <View>, aView, after it's handle has become invalid. The <boolean>
argument, aBoolean, indicates whether the state will be used to
immediately restore the receiver, in which case the state restoring
flag is set on aView and all its sub-views as they are traversed.
Note that the flag is set before the state is recorded, so it can be tested
in the #state implementation, but this is not usually necessary."
view := aView.
aBoolean ifTrue: [view isStateRestoring: true].
state := aView state.
placement := aView placement.
subViewStates := aView subViews collect: [:each |
ViewState recordStateOf: each forRecreate: aBoolean]!
restore
"Restore the receiver's view to its former glory"
view isStateRestoring: true.
view state: state.
subViewStates do: [ :each | each restore ].
view
placement: placement;
basicInvalidateLayout.
view isStateRestoring: false.! !
Aspect comment:
'Part of the PublishedAspectorInspector framework.
<Aspect>s are used to describe the published aspects of various objects. An Aspect descriptor can be combined with a particular object to create an <AspectAccessor> that can be used to access the subject object with the value/value> protocol. The <AspectAccessor> uses the aspect name to construct accessor messages (e.g. #myAspect and #myAspect:) for getting and setting the value. An Aspect instance also holds a presenter block (a <dyadicValuable>) which, when evaluated, will create a presenter suitable for editing the aspect as its model.
All objects understand the #publishedAspects message, which is used to answer a <LookupTable> (keyed on aspect name) of all the Aspect descriptors that are published by the object. This additional meta-information is used by the development tools (in particular the <PublishedAspectInspector>) to easily allow user interface editing of various objects. Classes wishing allow such editing must publish aspects for their instances, and should do this by overriding the #publishedAspectsOfInstances method to add appropriate Aspects to this table.
Instance Variables:
name <Symbol> identifying the aspect.
presenterBlock <dyadicValuable> to be evaluated to bring up a presenter on the aspect
editBlock <monadicValue> to be evaluated to edit the aspect
isMutable <Boolean> specifying whether the aspect can be modified in-place'!
!Aspect class methodsFor!
autostring: aStringAspectSymbol
"Answer an instance of the receiver for aStringAspectSymbol.
The aspect is editable using a TextPresenter with a single line editor view
that updates on each character"
^self name: aStringAspectSymbol
presenterBlock:
[:p :m |
| presenter |
presenter := TextPresenter createIn: p on: m.
presenter view updatePerChar: true.
presenter]!
bitmap: aBitmapAspectSymbol
"Answer an instance of the receiver for aBitmapAspectSymbol.
The aspect is viewable using an ImagePresenter with a 'Basic image' view
"Private - Answer suitable method text for compiling a read-accessor method
to substitute for the receiver (does not include the selector)"
^self subclassResponsibility!
selectorFrom: aSymbol
"Private - Answer a Selector generated from the argument aSymbol."
^aSymbol!
writeAccessorMethodText: targetString
"Private - Answer suitable method text for compiling a write-accessor method
(should not include the selector).
Write accessors normally answer self (i.e they have no explicit return value)."
^self subclassResponsibility! !
AXAutomationAspect comment:
'AXAutomationAspect is the abstract superclass of <Aspect>s specialised for accessing properties and fields of Active-X Automation objects. It is an extension of the PublishedAspectorInspector framework.'!
'Part of the PublishedAspectorInspector framework. KeyedAspect instances are used to describe the published aspects of a keyed collection. Typically these are accessed via #at: and #at:put: messages as governed by the KeyedAspectAccessor class.'!
!KeyedAspect class methodsFor!
key: aKey
"Answer an instance of the receiver created with aKey"
^self name: aKey! !
!KeyedAspect methodsFor!
= comperand
"Answer whether the receiver is considered equal to the <Object>, comperand."
^self == comperand or: [self species == comperand species and: [self key == comperand key]]!
"Private - Set the attribute of subjectObject described by the receiver
to valueObject."
^subjectObject at: self key put: valueObject! !
AXRecordAspect comment:
'AXRecordAspect is a specialised <Aspect> for accessing properties of user-defined Automation structures (as represented by instances of <AXRecord>). It is an extension of the PublishedAspectorInspector framework.'!
'DispatchAspect is a specialised <Aspect> for accessing properties of Automation objects through IDispatch. It is an extension of the PublishedAspectorInspector framework.'!
'Part of the PublishedAspectorInspector framework. BasicKeyedAspect instances are used to describe the published aspects of an object that can be accessed via #basicAt: and #basicAt:put: messages as governed by the BasicKeyedAspectAccessor class'!
!BasicKeyedAspect methodsFor!
getSelector
"Private - Answers the selector used for getting the aspect value from the subject"
^#basicAt:
!
putSelector
^#basicAt:put:!
readFrom: anObject
^anObject basicAt: self key!
writeInto: subjectObject value: valueObject
"Private - Set the attribute of subjectObject described by the receiver
'Part of the PublishedAspectorInspector framework.<KeyedAspectBatch> instances are used to describe a group of <KeyedAspects> of a keyed collection. Batching the keyed aspects up in this way via a <KeyedAspectBatchAccessor> allows the PAI to only display a certain number of elements at a time. This can substantially improve performance when displaying large (or slow to access) collections.'!
'ArrayField is an <ExternalField> type to represent <ExternalStructure> members which are arrays whose contents are actually embedded in the structure, as opposed to being merely pointed at from the structure.'!
!ArrayField class methodsFor!
type: aClass length: anInteger
"Answer a new instance of the receiver which is used for describing
embedded arrays of type aClass, with anInteger elements."
^self basicNew initialize;
fieldClass: aClass;
length: anInteger! !
!ArrayField methodsFor!
alignment
"Answer the alignment requirements for the receiver.
This is the default alignment required for a field of the receiver's type
when embedded in an array or structure, generally speaking this is the
same as the byte size."
^self elementSize!
arrayClass
"Private - Answer the class of <ExternalArray> that this field type describes."
^fieldClass!
byteSize
"Private - Answer the byte size of the embedded array the receiver represents.
By default we assume that the length of the receiver is specified in bytes."
^length * self elementSize!
elementSize
"Private - Answer the byte size of the structures/values that constitute
the elements of the embedded array the receiver represents."
^self arrayClass elementSize!
length
"Private - Answer the length of the embedded array represented by the receiver."
^length!
length: anInteger
"Private - Set the length (element count) of the embedded array the receiver
represents. Answer the receiver."
length := anInteger!
lengthString
"Private - Answer the length string to be inserted in the accessor."
^self length displayString!
readAccessorMethodText: contentsAccessString
"Private - Answer suitable method text for compiling a read-accessor method
to substitute for the receiver (does not include the selector)."
"Private - Answer a <StructureArray> which references the array
of structures embedded in the <ExternalStructure>, struct, in the
field described by the receiver. The result may be sent #at: and #at:put:
messages to get/set the actual elements in-place."
^self arrayClass
fromAddress: anExternal yourAddress + offset
length: self length
elementClass: self fieldClass! !
PointerArrayField comment:
''!
!PointerArrayField methodsFor!
alignment
"Answer the alignment requirements for the receiver.
All pointers are 32-bits."
^4!
arrayClass
"Private - Answer the class of <ExternalArray> that this field type describes."
^PointerArray!
elementSize
"Private - Answer the byte size of the structures/values that constitute
the elements of the embedded array the receiver represents.
All pointers are 32-bits."
^4! !
VariableStructureArrayField comment:
'VariableStructureArrayField is a class of <AttributeDescriptor> which can be used to describe those fields of <ExternalStructure>s which are themselves embedded arrays of <ExternalStructure>s. For example, give the C++ structure definitions:
struct PALETTEENTRY {...};
struct LOGPALETTE {
struct LOGPALETTE {
WORD palVersion;
WORD palNumEntries;
PALETTEENTRY palPalEntry[1];
};
then a template definition for LOGPALETTE might be as follows:
Note: The #byteSize method must be overridden in structures with variable length embedded items, as the base implementation is calculated statically. Furthermore such structures cannot be passed and returned by value because the VM is unable to determine the correct size.
Instance Variables:
None, but we hijack the superclass instance variable ''length'' to hold the selector used to get the length at runtime. This is not terribly clean, but reflects this classes late addition to the design.'!
!VariableStructureArrayField methodsFor!
elementClass
"Private - Answer the class of <ExternalStructure> used to represent elements of the receiver."
^fieldClass!
length
"Answer the length of the array at the field described
by the receiver. We don't know until run time what the length
is, so claim there is one element."
^1!
lengthString
"Private - Answer the length string to be inserted in the accessor."
^'self ', length!
readFrom: struct
"Private - Answer a <StructureArray> which references the array
of structures embedded in the <ExternalStructure>, struct, in the
field described by the receiver. The result may be sent #at: and #at:put:
messages to get/set the actual elements in-place."
^self arrayClass
fromAddress: struct yourAddress + offset
length: (struct perform: length)
elementClass: self elementClass! !
ArrayPointerField comment:
'ArrayPointerField is an <ExternalField> type to represent <ExternalStructure> members which are pointers to arrays.'!
!ArrayPointerField class methodsFor!
to: aClass length: anInteger
"Now deprecated in favour of #type:length: which is polymorphic
with <StructureArrayField>."
Notification deprecated.
^(super type: aClass) length: anInteger!
type: aClass length: length
"Answer a new instance of the receiver which is used for dereferencing
pointers to arrays objects of type aClass, of the specified fixed <integer> length."
^(super type: aClass) length: length! !
!ArrayPointerField methodsFor!
length
"Answer the <integer> length of the array pointed at by the field described
by the receiver. If this is a dynamic value which will vary at runtime depending
on the structure in which the field is embedded, then answer one."
^length!
length: elementCountOrSelector
"Private - Set the length of the array pointed at by the field described
by the receiver."
length := elementCountOrSelector!
lengthString
"Private - Answer the length string to be inserted in the accessor."
^self length displayString!
readAccessorMethodText: contentsAccessString
"Private - Answer suitable method text for compiling a read-accessor method
to substitute for the receiver (does not include the selector)."
"Private - Answer a <StructureArray> which references the array of structures
pointed at by the field described by the receiver in the <ExternalStructure>, struct.
N.B. The answer is a reference, and modifications to it will update the original buffer."
^self fieldClass
fromAddress: (struct sdwordAtOffset: offset)
length: self length
elementClass: self elementClass! !
PointerArrayPointerField comment:
''!
!PointerArrayPointerField methodsFor!
fieldClass
"Private - Answer the class of Smalltalk object to be used when dereferencing
pointers of the receiver's type."
^PointerArray! !
VariableStructureArrayPointerField comment:
'VariableStructureArrayPointerField is an <ExternalField> type to represent <ExternalStructure> members which are pointers to variable length arrays of structures where another field in the structure holds the length of the array, e.g. as in the various OLE counted array structures.'!
!VariableStructureArrayPointerField methodsFor!
length
"Answer the length of the array pointed at by the field described
by the receiver. We don't know until run time what the length
is, so claim there is one element."
^1!
lengthString
"Private - Answer the length string to be inserted in the accessor."
^'self ', length!
readFrom: struct
"Private - Answer a <StructureArray> which references the array of structures
pointed at by the field described by the receiver in the <ExternalStructure>, struct.
N.B. The answer is a reference, and modifications to it will update the original buffer."
^self fieldClass
fromAddress: (struct sdwordAtOffset: offset)
length: (struct perform: length)
elementClass: self elementClass! !
BOOLField comment:
''!
!BOOLField methodsFor!
accessorStem
"Private - Answer the receiver's 'accessorStem'."
^'dword'!
fieldClass
^Boolean!
readAccessorPostfix
"Private - Answer the receiver's accessor method prefix to be prepended
to automatically generated accessor read selectors."
^') asBoolean'!
readFrom: anExternal
"Private - Instantiate an object of the the type the receiver represents
at the receiver's offset in anExternal"
^(anExternal dwordAtOffset: offset) asBoolean
!
writeAccessorMethodText: contentsAccessString
"Private - Answer suitable method text for compiling a write-accessor method
to substitute for the receiver (does not include the selector)"
'TKindAliasAnalyzer is a class which wraps an OLE Automation <ITypeInfo> interface pointer that describes a ''typedef'' (a declaration of a name for a type), i.e. an ITypeInfo of type kind TKIND_ALIAS. It supports high level behaviours for analyzing the type information associated with typedefs, and resolving them down to the fundamental type referenced.'!
'TKindCoClassAnalyzer is a class which wraps an OLE Automation <ITypeInfo> interface pointer that describes a ''coclass'' (a COM object class). It adds higher level behaviours for analyzing the type information associated with that coclass, and for automatic generation of Smalltalk wrapper information for that coclass (essentially by adding behaviours to the wrappers generated for its interfaces).'!
'TKindEnumAnalyzer is a class which wraps an OLE Automation <ITypeInfo> interface pointer that describes an enumerated type (i.e. of type TKIND_ENUM). It adds higher level behaviours for analyzing the type information associated with that coclass, and for automatic generation.
TKindEnumAnalyzer generates constants for each of the members of its enumerated type into a <PoolConstantsDictionary> when sent #generate/#generateAs:. Using this facility one can very quickly and easily define a set of constants needed to use some externally defined object or function library, at least when a typelib is available.
The Active-X Component Wizard will automatically generate a constants pool for any type library that contains enumerated types when any structure or interface is generated from that type library.'!
'AXInterfaceTypeAnalyzer is the abstract superclass of <AXTypeInfoAnalyzer>s describing custom COM interfaces (TKindInterfaceAnalyzer) and dispatch interfaces (TKindDispatchAnalyzer).
AXInterfaceTypeAnalyzers wrap <ITypeInfo> pointers from a type library, providing behaviour which allows one to query information and generate wrapper classes appropriate for COM interfaces.
Instance Variables:
protocol <MethodProtocol>. Optional protocol grouping the basic methods of the interface.
isSource <boolean>. Flag caching whether the described interface is an event source.
Class Variables:
ReservedDispSelectors <IdentitySet> of <Symbol>.Selectors which should not be overridden by dispatch interfaces.
ReservedUnkSelectors <IdentitySet> of <Symbol>. Selectors which should not be overridden by custom interfaces.
Σ▀^]c5L▒uQc¼¼`ε╓G@⌠öÿ│▐┴àr_k>╖╓4╝╞═_¥ É 5║K│=é TF =≤$û═ÿGfÑ9╫▐â∙▐α}ü▀Æò<ª⌠VºcröΩ!!₧█Z⌠B=┼]▀│T≈╠v═U`Ä}▄╢ε. ì╜²≥µFíτDY½Θñ,<bo4║÷j1tC╠╦QìñMD1S@εÿ?Äs É ≡¼ª!!╡ç! !
TKindModuleAnalyzer comment:
'TKindModuleAnalyzer is a class which wraps an OLE Automation <ITypeInfo> interface pointer that describes a ''module'' (a DLL containing exported functions). It adds higher level behaviours for analyzing the type information associated with that DLL.
As of Dolphin 4.0 TKindModuleAnalyzer now provides for the automatic generation of an ExternalLibrary subclass with appropriate Smalltalk wrapper methods for the module.
Although this facility would appear to be of limited use, since very few modules are described with IDL and thus have type libraries available, it is quite easy to build a type library by pasting appropriate parts of the module''s C header file into an IDL file (which needs a library statement) and then running MIDL against it. Indeed this is usually the best option when faced with having to define a large ExternalLibrary. There are also various type libraries which have been constructed for popular modules (including much of the Win32 API) in order to ease the use of these libraries of functions from VB.'!
'TKindDispatchAnalyzer is a class which wraps an Active-X Automation <ITypeInfo> interface pointer that describes a ''dispinterface'' (a late-bound Automation interface), i.e. an ITypeInfo of type kind TKIND_DISPATCH. It supports high level behaviours for analyzing the type information associated with dispinterfaces, and for automatically generating a <IDispatch> wrapper subclasses.
Note: Certain dispinterfaces may use combinations of argument types and IDL flags which are not supported by the analyzer''s automatic wrapper method generation capabilities. Where possible generate dual interface wrappers as not only is automated support for these more advanced, but they also offer much better performance. Where not possible it may be necessary to hand craft wrappers for certain methods, perhaps using the auto-generated attempts as a start point. If a previously auto-generated method is moved out of the ''**auto-generated**'' category, then it can be safely modified without fear of it being overwritten.
Class Variables:
SpecialPropGets <LookupTable>. Map of special propget ids to associated method text (e.g. DISPID_VALUE)
'TKindInterfaceAnalyzer is a class which wraps an Active-X Automation <ITypeInfo> interface pointer that describes a ''interface'' (a dual or custom COM interface), i.e. an ITypeInfo of type kind TKIND_INTERFACE. It supports high level behaviours for analyzing the type information associated with interfaces, and for automatically generating a <IUnknown> wrapper subclasses.
Note: This analyzer''s capabilities in auto-generating method wrappers are comprehensive, but certain combinations of argument types and IDL flags may foil it. Please report such generation problems via the normal Object Arts support channels. Where it is not desirable to wait for a patch, one can hand craft wrappers for problem methods, perhaps using the auto-generated attempts as a start point. If a previously auto-generated method is moved out of the ''**auto-generated**'' category, then it can be safely modified without fear of it being overwritten.
≤E070,¼Ç6╗ñë è-╟┴ß╧Ω▐╨█Σ▓ñuvæÿΣ^@k;╕φ|bàVR+z^&O╫ÅNc4ór6âô ╩J¼Ö╢ô≥æ\Æg]gb╙▓jr║┴┼[ÉûaíQ÷vòδ^]+î÷▀Wÿu╛)▐ù═Γî«ràî█çsO¼⌠Q▒e;äα!!₧▐ ⌡@8îH╚π=dδçu╟Vf╧;±┌îV4ºª²╛µª≈tU╢ε▀`kaCFt;îτW2hD┴ìM¼öwNf∙▀oèHâ²╘╢Φ/ª╫δá≡W⌐ú╟┬ w ½sε g ≥ú`═lI⌡FìêëïƒT÷╝¼ΦC∙pα6í2π╥╓ⁿ>cZlFD8σ?£≤d£1╤#╡qJGzæorëΦu╣WeR╔»Ω:?Sq─ ═£┤.oɱU'╢φP▀╧┬▀
'TKindRecordAnalyzer is a class which wraps an Active-X Automation <ITypeInfo> interface pointer that describes a ''struct'' (a C structure). It adds high level behaviours for analyzing the type information associated with structures, and for automatic generation of <ExternalStructure> wrapper classes.
At present TKindRecordAnalyzer is not capable to automatically generating a full #defineFields class method. Support for such will be added in a future release. In the meantime a stub #defineFields is emitted that contains an IDL description of the structure in its comment, and the body of which sets the correct byte size for the structure. '!
'ClassDescription is an abstract class which adds descriptive information such as instance variable names and method categories to Behavior. This additional state and behaviour is generally not required or used by the VM, but is important for the development environment, the compiler in particular.
Instance Variables:
instanceVariables <String>. A space separated list of instance variable names.
methodsCatalogue <IdentityDictionary> mapping <MethodCategory>s to <Array>s of <Symbol>
protocols <Set> of <MethodProtocol>s implemented by (sub-)instances.'!
!ClassDescription methodsFor!
<= aClassDescription
"Answer whether the receiver is 'less than' aClassDescription.
By implementing this method, we enable Class objects to be stored
in a SortedCollection with the default sort block."
^self name <= aClassDescription name!
addInstVarName: aString
"Add a new instance variable to the receiver with the specified <readableString> name."
"Private - Answer a <collection> of the 'real' (i.e. non-pseudo or virtual) categories in the
receiver's method catalogue which include the specified selector."
| answer catClass selector |
answer := IdentitySet new: 5.
self methodsCatalogue keysAndValuesDo:
[:eachCategory :eachSelectors |
(eachSelectors identityIncludes: aSelector)
ifTrue: [answer add: eachCategory]].
catClass := self methodCategoryClass.
^answer! !
Class comment:
'"Instances" of Class describe the representation and behavior of objects. Class adds more comprehensive programming support facilities to the basic ones provided in the abstract superclass Behavior and more descriptive facilities to the ones provided in the abstract superclass ClassDescription. In particular Class adds the representation for class variable names and shared (pool) variables.
In reality, Class has no instances. All classes in the system are actually instances of a parallel hierarchy of Metaclass instances, but they do have the same shape as Class and are logically, if not physically, instances of it.
Instance Variables:
name <Symbol> which is the name of the class
classPool <PoolDictionary> mapping class variable name <String>s to values
sharedPools <Array> of <Symbol> names of shared variable pools
comment <String> comment about the class (like this one), or nil if none.
classCategories <Array> of <ClassCategory>. The categories of the class, if any.
_guid <GUID>. Unique identifier for the class.
'!
!Class class methodsFor!
allBehaviors
"Private - Answer a Set of all of the Behaviors contained in the system.
N.B. There is currently no specified ordering (hence the answer is a Set)."
'The False class implements the behaviour of the false (logical false) object.
False is a singleton whose sole instance is the object represented by the reserved word, false. (i.e. any reference to false will always answer true when compared with any other using the #== message).
False implement the ANSI protocols <Object> and <boolean>.'!
!False class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
!False methodsFor!
| operand
"Answer whether either the receiver OR the <boolean> argument, operand,
is true.
Implementation Note: The #ifTrue:ifFalse: is present in order to have the
VM check that the operand is actually a <Boolean>."
^operand ifTrue: [true] ifFalse: [false]!
and: operand
"Answer whether the receiver and the result of evaluating the <niladicValuable>,
operand, are both true. The argument is only evaluated if the receiver is true.
N.B. In the normal case where operand is a literal block the compiler inlines
the conditional operation in the home method."
^self!
asDword
"Answer the receiver in a form suitable for passing/returning as a
32-bit integer value."
^0!
asParameter
"Answer the value of the receiver in a form suitable for
passing to an external function call."
^0
!
ifFalse: operand
"Evaluate and answer the result of the evaluating the <niladicValuable>
argument, operand, if the receiver is false, otherwise answer nil.
N.B. This messuage is optimised by the compiler by inlining literal block
arguments in their home method."
^operand value!
ifFalse: falseOperand ifTrue: trueOperand
"Evaluate, and answer the result, of the <niladicValuable>, falseOperand, if
the receiver is false, or the <niladicValuable>, trueOperand, if the receiver is
true.
N.B. This message is normally optimised by the compiler if the operands are
literal blocks."
^falseOperand value!
ifTrue: operand
"Evaluate and answer the result of the evaluating the <niladicValuable>
argument, operand, if the receiver is true, otherwise answer nil.
N.B. This messuage is optimised by the compiler by inlining literal block
arguments in their home method."
^nil!
ifTrue: trueOperand ifFalse: falseOperand
"Evaluate, and answer the result, of the <niladicValuable>, falseOperand, if
the receiver is false, or the <niladicValuable>, trueOperand, if the receiver is
true.
N.B. This message is normally optimised by the compiler if the operands are
literal blocks."
^falseOperand value!
not
"Answer the logical inverse of the receiver."
^true
!
or: operand
"Answer whether either the receiver or the result of evaluating the
<niladicValuable> argument, operand, is true. The argument is only
evaluated if the receiver is false.
N.B. In the normal case where the argument is a literal block the compiler
optimizes this message by inlining the conditional operation in the home
method."
^operand value!
printOn: target
"Append the a textual representation of the receiver to the puttableStream, <target>..
Note that this override refines #printString to comply with the ANSI
protocol <boolean>."
target nextPutAll: 'false'!
xor: operand
"Answer whether either the receiver or the boolean argument <operand>
is true, but not both.
Since the receiver is false, the answer depends entirely on the argument."
^operand! !
True comment:
'The True class implements the behavior of the true (logical truth) object.
Trueis a singleton whose sole instance is the object represented by the reserved word, true. true is an identity object (i.e. any reference to true will always answer true when compared with any other using the #== message).
True implement the ANSI protocols <Object> and <boolean>.'!
!True class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
!True methodsFor!
& operand
"Answer whether the receiver and the <boolean> argument, operand,
are both true.
Implementation Note: The #ifTrue:ifFalse: is present in order to have the
VM check that the operand is actually a <Boolean>."
^operand ifTrue: [true] ifFalse: [false]!
and: operand
"Answer whether the receiver and the result of evaluating the <niladicValuable>,
operand, are both true. The argument is only evaluated if the receiver is true.
N.B. In the normal case where operand is a <niladicBlock> the compiler inlines
the conditional operation in the home method."
^operand value!
asDword
"Answer the receiver in a form suitable for passing/returning as a
32-bit integer value."
^1!
asParameter
"Answer the value of the receiver in a form suitable for
passing to an external function call."
^1
!
ifFalse: operand
"Evaluate and answer the result of the evaluating the <niladicValuable>
argument, operand, if the receiver is false, otherwise answer nil.
N.B. This messuage is optimised by the compiler by inlining literal block
arguments in their home method."
^nil!
ifFalse: falseOperand ifTrue: trueOperand
"Evaluate, and answer the result, of the <niladicValuable>, falseOperand, if
the receiver is false, or the <niladicValuable>, trueOperand, if the receiver is
true.
N.B. This message is normally optimised by the compiler if the operands are
literal blocks."
^trueOperand value!
ifTrue: operand
"Evaluate and answer the result of the evaluating the <niladicValuable>
argument, operand, if the receiver is true, otherwise answer nil.
N.B. This messuage is optimised by the compiler by inlining literal block
arguments in their home method."
^operand value!
ifTrue: trueOperand ifFalse: falseOperand
"Evaluate, and answer the result, of the <niladicValuable>, falseOperand, if
the receiver is false, or the <niladicValuable>, trueOperand, if the receiver is
true.
N.B. This message is normally optimised by the compiler if the operands are
literal blocks."
^trueOperand value!
not
"Answer the logical inverse of the receiver."
^false
!
or: operand
"Answer whether either the receiver or the result of evaluating the
<niladicValuable> argument, operand, is true. The argument is only
evaluated if the receiver is false.
N.B. In the normal case where the argument is a literal block the compiler
optimizes this message by inlining the conditional operation in the home
method."
^self!
printOn: target
"Append the a textual representation of the receiver to the puttableStream, <target>..
Note that this override refines #printString to comply with the ANSI
protocol <boolean>."
target nextPutAll: 'true'!
xor: operand
"Answer whether either the receiver or the boolean argument <operand>
is true, but not both.
Since the receiver is false, the answer is true only if the argument
is false."
^operand not! !
PrinterCanvas comment:
''!
!PrinterCanvas class methodsFor!
choose
"Answers a new instance of the receiver created with a non-owned hDC to a printer
chosen by the user with the PrintDialog. If the user cancels out of the dialog
then we answer nil."
| hDC |
^(hDC := PrintDialog showModal) isNil
ifFalse: [self withOwnedDC: hDC]! !
!PrinterCanvas methodsFor!
basicFree
"Private - Free the external resources associated with the receiver."
self endPage; endDoc.
super basicFree!
endDoc
"Signal the end of the current document."
GDILibrary default endDoc: self asParameter
!
endPage
"Signal the end of the current page."
GDILibrary default endPage: self asParameter
!
startDoc
"Signal the start of a new document."
self startDocNamed: SessionManager current applicationName!
'VirtualMethodCategory is the class of method categories whose membership is calculated on demand rather than looked up in the method catalogue of the method''s class. As virtual categories usually have no static record in the image, they typically carry no space overhead. This is a significant benefit for the privacy categories ''private'' and ''public'' (membership of which is determined by a bit flag in the method header), as every method in the system is in one or the other. The downside is that querying the membership of the category takes more time, although this is not likely to be noticeable in normal operation.
VirtualMethodCategory itself is abstract, but provides much of the implementation for simple virtual categories, which typically need implement only #includesMethod:
Virtual method categories are sometimes referred to as pseudo-categories.
Instance Variables:
None
Class Variables:
None'!
!VirtualMethodCategory methodsFor!
addMethodSilently: method
"Private - Add the <CompiledMethod>, method, to the set of methods that are members
of the receiver. Pseudo-categories have a calculated membership and typically can't be
added to in this manner."
!
behaviors
"Private - Answer a collection of <Behavior>s which have the receiver as one of its
method categories. As this is a pseudo category, we claim the allegiance of all
Behaviors in the system."
^self class environment allBehaviors!
includesMethod: method
"Answer whether the receiver includes the <CompiledMethod>, method."
^self subclassResponsibility!
isVirtual
"Answer whether the receiver is a virtual category, i.e. one that
has calculated contents. All pseudo-categories are virtual, but not vice versa."
^true!
methodsInBehavior: class
"Answer all the methods in the <Behavior>, class, which are members of the receiver,
determined by examining each methods header flags."
"Private - Remove the <CompiledMethod>, method, from the set of
methods that are members of the receiver, and make no fuss about it.
In general the membership of pseudo-categories is generated and in
order to remove a method it is necessary to modify it so that it no longer
fits the membership criteria of the category."! !
AllMethodsCategory comment:
'AllMethodsCategory is a virtual method category class the dynamically generated membership of which includes all methods.
Instance Variables:
None
Class Variables:
None'!
!AllMethodsCategory class methodsFor!
current
"Answer the singleton instance of the receiver."
^Current!
initialize
"Private - Initialize the receiver.
self initialize.
"
Current := super newNamed: 'All'!
newNamed: categoryName
"Private - Answer a new subinstance of the receiver with the
<readableString> name, categoryName."
^self shouldNotImplement!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
Current := nil! !
!AllMethodsCategory methodsFor!
includesMethod: method
"Answer whether the receiver includes the <CompiledMethod>, method.
The 'All' methods category includes all methods!!"
^true! !
FailedCompilationsCategory comment:
'FailedCompilationsCategory is a virtual method category class the dynamically generated membership of which includes all methods which failed to compile during a file-in or class recompilation (e.g. after deleting or renaming an instance variable).
"Answer whether the receiver includes the <CompiledMethod>, method."
^method isCompilationFailure! !
MethodPrivacyCategory comment:
'MethodPrivacyCategory is a virtual method category class used to dynamically group private/public methods.
This class has two instances representing the ''private'' and ''public'' categories.
The "privacy" of a method is recorded in the method header flags, and it is those flags which instantiations of this class test against to identify methods with the corresponding privacy level. Every method in the system will be in one or other MethodPrivacyCategory.
Instance Variables:
privacy <Integer> bit mask used to compare against the bits of the method headers.
Class Variables:
None'!
!MethodPrivacyCategory class methodsFor!
initialize
"Private - Initialize the receiver's class variables, etc.
N.B. This is present to support the Dolphin boot process, it is
"Answer whether the receiver includes the <CompiledMethod>, method."
^method isExternalCall not and: [method isPrimitive]! !
ReferencesCategory comment:
'ReferencesCategory is the class of virtual method categories which dynamically determines their membership to include only those methods which reference a particular object from their literal frame.
ReferencesCategory has instances such as the ''*-subclass responsibility'' category, but you can create your own references categories by following the examples in the class #initialize method.
Instance Variables:
object <Object> to which a reference confers category membership.
Class Variables:
None'!
!ReferencesCategory class methodsFor!
initialize
"Private - Initialize the receiver.
ReferencesCategory initialize.
You can add your own reference categories for the selectors you are interested in.
Unless you want this method to appear in the category too, you should use #asSymbol to
"Answer whether the receiver includes the <CompiledMethod>, method.
A method is considered to be in a ReferencesCategory if it references
the object which that category is interested in."
^method refersToLiteral: literal!
literal: anObject
"Set the value of the receiver's 'literal' instance variable to the argument, anObject."
literal := anObject! !
UnclassifiedMethodsCategory comment:
'ReferencesCategory is a virtual method categories class which dynamically determines its membership to be those methods which are categorized only in other virtual categories, i.e. those methods which have not been specifically allocated a category.
'PackedReferencesCategory is the class of virtual method categories dynamically determines their membership to include only those methods which have packed byte codes and reference a particular object from their literal frame. In practice this will include only those methods that consist of a send to self of a zero argument selector.
PackedReferencesCategory has instances such as the ''*-subclass responsibility'' category, but you can create your own references categories by following the examples in the class #initialize method.'!
!PackedReferencesCategory class methodsFor!
initialize
"Private - Initialize the receiver.
PackedReferencesCategory initialize.
You can add your own reference categories for the selectors you are interested in.
Unless you want this method to appear in the category too, you should use #asSymbol to
'A Bag is a variable sized, unordered, collection which is extensible and contractible, but not accesssible using external keys. Bag is similar to Set, but can contain duplicate elements (which it counts). Elements are considered to be duplicates if they compare as equal using #=.
Bag conforms to the ANSI protocols:
Object
collection
extensibleCollection
Bag'!
!Bag class methodsFor!
identityNew
"Answer a new instance of the receiver with default initial capacity, which uses identity
as the comparison for identifying duplicate elements."
^self identityNew: 3
!
identityNew: anInteger
"Answer a new instance of the receiver with sufficient initial capacity for anInteger unique
elements, which uses identity as the comparison for identifying duplicate elements."
^super new contents: (IdentityDictionary new: anInteger)
!
new
"Answer a new instance of the receiver with default initial capacity,
which uses equality as the comparison for identifying duplicate elements."
^self new: 3!
new: count
"Answer a new instance of the receiver with sufficient initial capacity for
the number of elements specified by the <integer> argument, count,
which uses equality as the comparison for identifying duplicate elements."
^super new
contents: (LookupTable new: count)!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect collection: #elements);
yourself! !
!Bag methodsFor!
add: newElement
"Include the <Object> argument, newElement, as an element of the receiver, once.
newElement must not be nil. Answer newElement."
^self add: newElement withOccurrences: 1.!
add: newElement withOccurrences: count
"Include the <Object> argument, newObject, as an element of the receiver,
anInteger number of times. newElement must not be nil.
Answer newObject.
Note that nil is not a valid value for newElement, but the ANSI standard
specifies that the result is undefined if nil is added, so we do not explicitly
Raise an exception if otherCollection is not the same size as the receiver."
self size = otherCollection size
ifFalse: [^self error: 'collections are of different sizes'].
self keysAndValuesDo: [:i :elem |
operation
value: elem
value: (otherCollection at: i)]!
writeStream
"Answer a WriteStream on the receiver."
^WriteStream on: self! !
Set comment:
'Set is a generic collection class which represents an unordered, extensible/contractible, collection, accessible only by value, not by external keys. Element comparison is by equality (i.e. using #hash and #=).'!
!Set class methodsFor!
initialize
"Private - Initialize the receiver's class variables."
self initializeSizeTable
!
initializeSizeTable
"Private - Construct a difference table which can be used to calculate the nearest
larger prime for each odd integer up to a certain limit. The greater the limit the more
table space is used, although as this is a byte array this isn't likely to be a problem.
Ultimately the use of a byte array limits the table size since at some point the offset
to the next prime will be greater than 255.
self initializeSizeTable
"
| primes last count max |
max := (2**12)+1. "Max size for which entry will be found in table"
'ArrayedCollection is the class of <SequenceableCollection>s of a fixed size which are indexable by integer keys from 1 to the size of the collection.'!
!ArrayedCollection class methodsFor!
new
"Answer a new, empty, instance of the receiver."
^self new: 0!
new: elementCount withAll: elementValue
"Answer a new instance of the receiver with <integer>, elementCount,
elements, each of which is initialized to the <Object>, elementValue.
Included mainly for compatibility with VisualWorks."
^(self new: elementCount)
atAllPut: elementValue;
yourself!
with: element1
"Answer a new instance of the receiver containing the single
<Object> element, element1."
^(self new: 1)
at: 1 put: element1;
yourself!
with: element1 with: element2
"Answer an instance of the receiver containing the <Object>
arguments as its elements"
^(self new: 2)
at: 1 put: element1;
at: 2 put: element2;
yourself!
with: element1 with: element2 with: element3
"Answer an instance of the receiver containing the <Object>
"If the receiver contains an identity match for anObject replace the first with newElement,
otherwise increase the size of the receiver, and append newElement. Answer the index.
This is a very useful method in many system support tasks (e.g. the Dependency mechanism)"
| size index |
size := self size.
index := self basicIdentityIndexOf: anObject from: 1 to: size.
index == 0 ifTrue: [
index := size + 1.
self resize: index ].
self at: index put: newElement.
^index!
resize: anInteger
"Override back to the primitive implementation for indexable objects (see Object>>resize:)"
<primitive: 101>
^super resize: anInteger!
size
"Answer the size of the collection.
Implementation Note: Subclasses are generally implemented as indexable objects,
so we can use the indexable instance variable size primitive.
This primitive should not fail."
<primitive: 62>
^self primitiveFailed
! !
Interval comment:
'<Interval>s represent a finite arithmetic progressions, that is a <sequencedReadableCollection> of numbers across a specified range and with a specified step between each element.
Instance Variables:
start <number>. First element in the collection.
stop <number>. Last element in the collection.
step <number>. Difference between elements of the collection (approximate where the elements are Floats)
'!
!Interval class methodsFor!
from: from to: to
"Answer a new instance of the receiver representing the interval
between the <number> arguments from and to inclusive in increments
of the <integer> one."
^self basicNew
setFrom: from to: to by: 1!
from: from to: to by: by
"Answer a new instance of the receiver representing the interval
between the <number> arguments from and to inclusive in increments
of the <number> by."
^self basicNew
setFrom: from to: to by: by!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect integer: #start);
add: (Aspect integer: #stop);
add: (Aspect integer: #step);
yourself! !
!Interval methodsFor!
- delta
"Answer a new Interval the same as the receiver, but negatively offset by the specified delta."
^self class from: start - delta to: stop - delta by: step!
+ delta
"Answer a new Interval the same as the receiver, but positively offset by the specified delta."
^self class from: start + delta to: stop + delta by: step!
= anObject
"Answer whether the receiver and the <Object>, comparand,
are considered equivalent (that is they contain the same number
of equivalent objects in the same order, and are of like class).
The supersend ensures that expressions such as '(1 to: 5) = #(1 2 3 4 5)' are true"
"Append, to the <puttableStream> argument, target, a string whose characters
are a description of the receiver as a developer would want to see it."
target
nextPut: $(;
print: self start;
nextPutAll: ' to: ';
print: self stop.
self step = 1 ifFalse: [
target
nextPutAll: ' by: ';
print: self step].
target nextPut: $)!
publishedKeyedAspects
"Answers a LookupTable of the published aspects of the receiver's keyed contents"
^LookupTable new
!
setFrom: startInteger to: stopInteger by: stepInteger
"Private - Initialize the receiver's instance variables."
start := startInteger.
stop := stopInteger.
step := stepInteger
!
size
"Answer the inclusive size of the receiver."
^self isEmpty
ifTrue: [0]
ifFalse: [stop - start // step + 1]!
species
"Answer the kind of <sequencedReadableCollection> that should result
from enumerations such as #collect: and #select: when applied against
the receiver.
Note that this message helps to support the ANSI protocol refinements
of the sequencedReadableCollection copying messages (e.g. #copyFrom:to:)
in the Interval protocol, without actually having to reimplement those
messages in the Interval class."
^Array!
start
"Answer the first element of the receiver."
^start!
start: anInteger
"Sets the first element of the receiver to anInteger"
start := anInteger!
step
"Answer the receiver's step."
^step
!
step: anInteger
"Sets the step element of the receiver to anInteger"
step := anInteger!
stop
"Answer the end of the receiver's interval. Depending on the step, this is not necessarily
the last element of the receiver."
^stop
!
stop: anInteger
"Sets the last element of the receiver to anInteger"
stop := anInteger! !
OLEEnumerator comment:
'OLEEnumerator is a <sequencedReadableCollection> that wraps an OLE enumeration interface (IEnumXXXX). It provides an efficient way to treat an enumeration supplied by a COM object as a full-blown Smalltalk collection.'!
!OLEEnumerator class methodsFor!
onIEnum: anIEnum
"Answer a new instance of the receiver which provides access via the Collection protocol
to the specified IEnum."
^self new
interface: anIEnum
! !
!OLEEnumerator methodsFor!
add: newElement
"OLE IEnums are immutable, and therefore not extensible."
^self shouldNotImplement!
approxSize
"Private - Answer the approximate size of the receiver.
Implementation Note: The size of enumerators must be calculated (no tally
is kept), which is expensive, so we revert to the basic collection
implementation."
^2!
at: index
"Answer the element of the receiver at the specified index. If the index
'String is the class of <ArrayedCollection>s whose elements are <Character>s.
N.B. Dolphin Strings are, unlike Smalltalk-80 strings, null terminated. Space for the null terminator is implicity included when a String is allocated, but is not reported when the size of the String is requested.
String complies with the following ANSI protocols:
"Private - Please use #asPositiveInteger (or #asInteger) instead"
^self value!
stbSaveOn: anSTBOutFiler
"Save out a binary representation of the receiver to anSTBOutFiler.
Output nil in place of the receiver as the future validity of an external handle is uncertain."
anSTBOutFiler saveObject: self as: nil! !
BSTR comment:
'BSTR is an external structure to represent the OLE Automation string type of the same name.
BSTR is defined as:
typedef OLECHAR FAR* BSTR;
That is, it is a pointer to a Unicode character string (although it cannot be used interchangeably with the latter - see below).
As the underlying BSTR type is actually a pointer we define it here as a subclass of ExternalAddress, rather than try to squeeze it into the ExternalStructure hierarchy.
BSTRs are both null-terminated AND counted. They store their length as a 32-bit integer in the location immediately preceding the data of the string. BSTRs may also contain embedded nulls, which are included in the reported size, although the terminating null is not. Furthermore a BSTR may (validly) be null, in which case it behaves as if it were an empty string, as per the OLE Automation convention. It is worth noting that VB will usually pass a NULL pointer in place of the empty string.
BSTRs are stored in memory managed by the OLE Automation Library, which enables ownership to be passed from one function to another: (down in the depths of OLEAut32.DLL the SysXXX functions map onto the services of the COM task memory allocator). Where a function is expecting a BSTR argument, then a BSTR allocated with SysAllocString must be passed rather than an ordinary Unicode string. The BSTR class can be used to create suitable parameters from other Smalltalk <readableString> classes.
BSTRs use finalization to safely manage the sys. alloc''d string, but they may be explicitly free''d too.'!
'REFGUID is a pointer class for referencing guids. It is mainly for use in situations where a GUID* pointer is passed back into Smalltalk, e.g. in block callbacks and COM method implementations.
Two distinct classes are provided for guids because, as of version 3.0, all classes in the system have an associated <GUID>. The GUID class is now a standard byte object subclassed directly from Object. The advantage of moving GUID itself out of the ExternalStructure hierarchy is that it avoids doubling the number of objects required to hold the per-class guids. The disadvantage is that GUID instances are no longer able to act as a pointer/references to externally stored guids, and hence we need this class to meet that requirement.
e.g.
REFGUID fromAddress: Object guid yourAddress'!
!REFGUID class methodsFor!
fromInteger: anInteger
"Answer a new instance of the receiver with contents copied from anInteger"
^self new
basicDwordAtOffset: 0 put: anInteger;
yourself! !
!REFGUID methodsFor!
_collate: comperand
"Private - Answer the ordering relationship between the receiver
'UnicodeString is a minimal class to support wide character (16-bit) Unicode strings. Natively Dolphin uses byte-character strings at present.
UnicodeStrings can be constructed from <String>s when needed by sending the #asUnicodeString message, and converted back again by sending the #asString message.'!
!UnicodeString class methodsFor!
elementSize
"Answer the size of the elements of the receiver in bytes."
^2!
fromAddress: anAddress
"Answer a new String instantiated from the null terminated string at anAddress."
| len |
len := KernelLibrary default lstrlenW: anAddress.
^self fromAddress: anAddress length: len!
fromAddress: anAddress length: anInteger
"Answer a new UnicodeString, of length anInteger, copied from the first anInteger
characters pointed at by anAddress."
| answer |
answer := self new: anInteger.
anAddress asExternalAddress replaceBytesOf: answer from: 1 to: anInteger*2 startingAt: 1.
^answer!
fromString: aString
"Answer a new instance of the receiver containing the same characters as the <String>
argument.
Implementation Note: CP_ACP is the only code page supported by Win95."
| answer |
answer := self new: aString size.
(KernelLibrary default
multiByteToWideChar: CP_ACP
dwFlags: 0
lpMultiByteStr: aString
cchMultiByte: -1
lpWideCharStr: answer
cchWideChar: answer basicSize) == 0
ifTrue: [^KernelLibrary default systemError].
^answer!
new: anInteger
"Answer an instance of the receiver to accomodate exactly
"Private - Initialize the receiver's instance variables."
super initialize.
pathologist := self class!
pathologist
"Private - Answer the receiver's 'pathologist'. #elementsExpired: messages sent
to the receiver by the MemoryManager are forwarded to the pathologist for it to
do as it wishes with the receiver's Corpse elements. By default the pathologist
is the receiver's class, and the receiver does not expect to receiver any
#elementsExpired: messages."
^pathologist!
pathologist: anObject
"Private - Set the receiver's 'pathologist' to anObject. See #pathologist."
anObject isNil
ifTrue: [pathologist := self class]
ifFalse: [pathologist := anObject]! !
LinkedList comment:
'LinkedList is a class of <SequencedGrowableCollection> which is sequenced, ordered, contractible, expandable, readable and writeable. The implementation is as an intrusively, singly, linked list (i.e. the elements hold the pointer to the next element), and requires that the elements of a LinkedList must be a kind of <Link> (or support the same protocol).
N.B. LinkedList is primarily present as an implementation artifact. The fact that it expects its elements to hold the makes it of limited use, since, unlike other SequenceableCollections, it cannot hold any type of object, and each element can only every exist in one linked list.
Instance Variables:
firstLink <Link>. Head of the list.
lastList <Link>. Tail of the list.'!
!LinkedList methodsFor!
addFirst: aLink
"Add aLink at the head of the list; answer aLink."
self isEmpty ifTrue: [lastLink := aLink].
aLink nextLink: firstLink.
^firstLink := aLink!
addLast: aLink
"Add aLink at then end of the list; answer aLink."
self isEmpty
ifTrue: [firstLink := aLink]
ifFalse: [lastLink nextLink: aLink].
lastLink := aLink.
^aLink!
approxSize
"Private - Answer the approximate size of the receiver.
Implementation Note: The size of LinkedLists must be calculated (no tally
is kept), which is expensive, so we revert to the basic collection
implementation."
^2!
at: index
"Answer the element that is the index'th Link of the linked list."
| i aLink |
i := 1.
aLink := firstLink.
[aLink isNil] whileFalse: [
i = index ifTrue: [^aLink].
i := i + 1.
aLink := aLink nextLink].
^self errorSubscriptBounds: index
!
at: index put: anObject
"Store anObject as the index'th element of the receiver.
Not supported by LinkedLists at present."
^self shouldNotImplement!
do: operation
"Evaluate the <monadicValuable> argument, operation, for each of the elements of the
receiver. Answers the receiver."
| aLink |
aLink := firstLink.
[aLink isNil] whileFalse: [
operation value: aLink.
aLink := aLink nextLink]!
isEmpty
"Answer whether the receiver contains no elements.
Implemenation Note: Override superclass to provide a more efficient implementation."
^firstLink isNil
!
remove: oldElement ifAbsent: exceptionHandler
"Remove oldElement from the list and answer it, or evaluate the niladic
valuable exceptionHandler if it's not found in the list.
Implemenation Note: We use identity comparison, because the Links
of a list are unique (necessitated by the 'intrusive' implementation)."
Implementation Note: We maintain no kind of tally, so we must traverse
the list to determine this - i.e. it's going to be quite SLOW."
^self countElements! !
ListModel comment:
'ListModel implements the <listModel> protocol for identity based <sequencedCollecion>s. All of the manipulations that modify the list will trigger notification events such that Observers will be informed of the changes. The <listModel> protocol defines the following events:
#listChanged
#item:addedAtIndex:
#itemRemovedAtIndex:
#itemUpdatedAtIndex:
ListModel now uses a configurable policy to locate its elements, which means that EqualityListModel is redundant and should no longer be used.
Instance Variables:
list <sequencedCollection> which is the underlying list being managed.
events <EventsCollection> holding the model''s event registrations.
searchPolicy <searchPolicy>. Policy used to search the receiver''s collection for elements.
'!
!ListModel class methodsFor!
defaultSearchPolicy
"Answer the default <searchPolicy> used by instances of the receiver."
^SearchPolicy identity!
new
"Answer a new initialized instance of the receiver, with the default search policy
installed, on an empty OrderedCollection."
^self on: OrderedCollection new!
new: count
"Answer a new instance of the receiver with an initial capacity of at least
<integer> count elements (i.e. the size is a hint)."
^self on: (OrderedCollection new: count)!
newEquality
"Answer a new initialized instance of the receiver with the equality <SearchPolicy>."
^self newWithSearchPolicy: SearchPolicy equality!
newWithSearchPolicy: searchPolicy
"Answer a new instance of the receiver with the specified <SearchPolicy>."
^self on: OrderedCollection new searchPolicy: searchPolicy!
on: aSequenceableCollection
"Answer an instance of the receiver wrapped around the <sequencedCollection> argument
and using the default <SearchPolicy>."
^self on: aSequenceableCollection searchPolicy: self defaultSearchPolicy!
on: list searchPolicy: searchPolicy
"Answer a new initialized instance of the receiver, on the <sequencedReadableCollection>, list,
and the <searchPolicy>, searchPolicy."
^super new
setList: list searchPolicy: searchPolicy
!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #itemUpdatedAtIndex:;
add: #item:addedAtIndex:;
add: #listChanged;
add: #itemRemovedAtIndex:;
yourself.
!
stbConvertFrom: anSTBClassFormat
"Convert from earlier version models.
1: Added 'events' instance variable to ListModel.
2: Added 'searchPolicy' instance variable."
^[:data | | newInst |
newInst := self basicNew.
newInst searchPolicy: self defaultSearchPolicy.
data keysAndValuesDo: [:i :v | newInst instVarAt: i put: v].
newInst]!
stbVersion
^2!
with: aSequenceableCollection
"The superclass definition of this selector is to answer a new collection with the argument as the single
initial element. This old definition in this class from 4.0 and earlier clashes with that meaning, and is therefore
deprecated. Use #on: instead."
Notification deprecated. "Use #on:"
^self on: aSequenceableCollection!
with: list searchPolicy: searchPolicy
Notification deprecated. "Use #on:searchPolicy:"
^self on: list searchPolicy: searchPolicy! !
!ListModel methodsFor!
add: newElement
"Add newElement as a new element of the receiver. Answers newElement."
self addAnsweringIndex: newElement.
^newElement!
add: newElement afterIndex: index
"Add newElement to the receiver immediately after the element currently at the
specified index. index must be between 0 and the receiver's current
size (if not raise an exception). Answer newElement."
"As #set, except that the excess signal count of the receiver is always set to 0.
This 'pulsing' behaviour is useful for signalling a process only if there is one
waiting, and otherwise leaving the receiver unsignalled."
self primSetSignals: 0!
reset
"Reset the excess signals recorded by the receiver to zero. There is no effect on any waiting processes."
signals := 0
!
set
"As #signal, except that if there are no Processes waiting for the receiver
then the excess signal count is set to one, no matter how many times #set
is sent, and no matter what its previous value. This is useful for
implementing process synchronisation 'Events', whereby one wants to record
that something has happened, but not how many times it has happened."
self primSetSignals: 1!
signal
"Send a signal through the receiver. If one or more Processes are Waiting on the receiver,
then transition the first of those Processes (on a FIFO basis, independent of priority)
from Waiting to Ready.
If no Processes are Waiting on the receiver, then the excess signal is remembered so that
subsequent #waits will not cause the sending Process to Wait.
The primitive should not fail.
N.B. A signalled Process will not normally run immediately unless it is of a higher priority
than the current active Process (i.e. does not yield), and there are not already Processes at
or above its priority which are also Ready (these will run instead)."
<primitive: 85>
^self primitiveFailed!
terminateProcess
"Terminate the first process waiting on the receiver"
self isEmpty
ifFalse: [self first terminate]!
wait
"The active Process must receiver a signal through the receiver before proceeding.
Waiting processes may be interrupted, but will return to waiting when they have
finished processing the interrupt. See #wait: and #wait:ret: for further details."
| ret |
ret := Array new: 1.
self wait: INFINITE ret: ret.
^ret basicAt: 1!
wait: timeout
"The active Process must receive a signal through the receiver before
proceeding, or be interrupted (i.e. receive an interrupt from the VM), or timeout
after anInteger milliseconds. See #wait:ret: for further details.
The answer (written into the first slot of the return value holder by the primitive) could be
WAIT_OBJECT_0 if the wait completed successfully (either because the Semaphore had
excess signals, or because it was signalled), or WAIT_IO_COMPLETION if the primitive
was interrupted, or WAIT_TIMEOUT if the wait timed out. BUT, the latter two results are
not actually possible from this method since
1) an interrupted process will either not return here (if the Semaphore>>wait is returned
over and unwound), or will be resumed when the interrupt complets.
2) we request an INFINITE timeout."
| ret |
ret := Array new: 1.
self wait: timeout ret: ret.
^ret basicAt: 1!
wait: timeout ret: returnValueHolder
"Private - The active Process must receive a signal through the receiver before
proceeding, or be interrupted (i.e. receive an interrupt from the VM), or timeout
after anInteger milliseconds. Answer the argument, returnValueHolder, with its
first instance variable updated to hold and <integer> return code.
At present the only valid values for timeout are, INFINITE, meaning wait for ever,
and 0, meaning don't wait at all. The behaviour of these is as follows:
INFINITE- Wait until the semaphore is signalled, answering WAIT_OBJECT_O.
0 - If the receiver has excess signals, then decrement the count, and
answer WAIT_OBJECT_O, otherwise return immediately without waiting,
but answer WAIT_TIMEOUT. i.e this is a way to 'poll' a Semaphore.
If no signal has been sent, then the active Process will be transitioned from Running
to Waiting until one is sent, when it may be returned to the Ready state.
The purpose the returnValueHolder argument is to allow #wait to atomically wait
for the availablity of a Semaphore _and_ update a variable in the enclosing context
as to the outcome of that wait. This is important to the correct implementation of
Semaphore>>critical:, for example, as otherwise it is not possible to reliably
determine in unwind handling whether the Semaphore was grabbed or not - one
can't rely on a normal return value, because the process may not yet have proceeded
far enough to assign it back into a temporary in the calling context.
Primitive failure reasons:
0 - One or other argument is not a SmallInteger
1 - receiver's excess signal count is not a SmallInteger (i.e. receiver corrupt).
2 - anInteger is not either INFINITE (-1) or 0.
4 - returnValueHolder is not of an appropriate shape to hold the return value
(it must be a pointer object with at least one slot, e.g. a one element Array)"
<primitive: 86>
^self primitiveFailed! !
EqualityListModel comment:
'N.B. EqualityListModel is now deprecated, as ListModel itself supports a pluggable search policy. A ListModel with the same behaviour can be instantiated using ListModel class>>newEquality.
EqualityListModel implements the <listModel> protocol for equality based <sequencedCollecion>s. EqualityListModel uses equality searches to locate its elements. See ListModel if identity matching is required.
'!
!EqualityListModel class methodsFor!
defaultSearchPolicy
"Answer the default <searchPolicy> used by instances of the receiver."
^SearchPolicy equality!
new
"Answer a new initialized instance of the receiver, with the default search policy
installed, on an empty OrderedCollection."
Notification deprecated. "Class, not message, is deprecated"
^ListModel newEquality!
with: aSequenceableCollection
"Answer an instance of the receiver wrapped around aSequenceableCollection"
Notification deprecated. "Note that it is the class which is deprecated, rather than this message"
^ListModel on: aSequenceableCollection searchPolicy: self defaultSearchPolicy! !
SortedCollection comment:
'SortedCollection is a class of <SequencedGrowableCollection>s whose elements are ordered in the sequence specified by a user-definable sort order function (the sort "block", actually a <dyadicValuable>).
SortedCollection complies with the ANSI protocols:
Object
collection
extensibleCollection
sequencedCollection
sequencedContractibleCollection
sequencedReadableCollection
SortedCollection
Elements can be added, removed or inserted, and can be accessed using external integer keys. However, it is an error to attempt to insert or replace elements at specific indices using any of the methods such as #at:put:, as this might invalidate the sort order.
Instance Variables:
sortBlock <dyadicValuable>
'!
!SortedCollection class methodsFor!
caseSensitiveSortBlock
"Answer a dyadic valuable which can be used to sort Strings into ascending
order on a case sensitive basis."
^[:a :b | (a trueCompare: b) <= 0]!
defaultSortBlock
"Answer a dyadic valuable to be used, by default, for sorting the
elements of the receiver.
Implementation Note: For maximum performance we implement #value:value:
directly, so answer self."
^self!
new: anInteger
"Answer an instance of the receiver with capacity for <integer> count
elements, sorted according to the default sort block."
^(super new: anInteger)
setSortBlock: self defaultSortBlock;
yourself!
sortBlock: discriminator
"Answer a new instance of the receiver which uses the <dyadicValuable> argument,
discriminator, to sort its elements. When evaluated, discriminator should answer whether
its first parameter should be ordered before the second parameter.
Note: The discriminator does not need to be a BlockClosure (despite the #sortBlock:
message, which is historic), it must simply understand the #value:value: message
from the dyadic valuable protocol."
^super new
setSortBlock: discriminator;
yourself!
value: anObject1 value: anObject2
"Private - Implement this part of the <dyadicValuable> protocol in order that
the receiver can be its own default sort 'block' which improves sorting
performance. Note however that it is usually faster to sort using #< (especially
if the collection is already in sort order, or contains a large number of similar
keys), but historically Smalltalk has always used #<=."
#todo "Draft ANSI standard specified #< as default sort block".
^anObject1 <= anObject2! !
!SortedCollection methodsFor!
, operand
"This is the concatenation operation. Answer a copy of the receiver with
each element of the <sequencedReadableCollection> argument, operand,
added, in the receiver's sort order."
^self copy
addAll: operand;
yourself!
add: newElement
"Add the <Object>, newElement, as a new element of the receiver,
inserting it in the correct place to maintain the sort ordering
of the receiver. Answers newElement."
self addAnsweringIndex: newElement.
^newElement!
add: newElement afterIndex: index
"Add newElement to the receiver immediately after the element currently at the
specified index. index must be between 0 and the receiver's current
size (if not raise an exception). Answer newElement.
SortedCollections maintain their own ordering, so this is not a valid operation."
^self shouldNotImplement!
add: newElement beforeIndex: index
"Add newElement to the receiver immediately before the element currently at the specified
index (i.e. the newElement will then have that index). index must be between 1 and the
receiver's current size plus 1 (if not raise an exception). Answer newElement.
SortedCollections maintain their own ordering, so this is not a valid operation."
^self shouldNotImplement!
addAll: aCollection
"Include all the elements of the <collection> argument as elements of the receiver.
'PluggableSet is the class of <Set>s which support a pluggable <searchPolicy>, and which can thus be configured to behave in the same way as either standard <Set>s (equality search) or <IdentitySet>s (identity search), or indeed any user-defined search policy.
Instance Variables:
searchPolicy <searchPolicy>. The policy used to hash and compare elements of the receiver.'!
!PluggableSet class methodsFor!
defaultSearchPolicy
"Answer the default <searchPolicy> used by instances of the receiver."
^SearchPolicy equality!
new: anInteger searchPolicy: aSearchPolicy
"Answer a new instance of the receiver with an initial capacity of at least
<integer> count elements (i.e. the size is a hint), and with the specified <searchPolicy>."
"Private - Answer the index of the given object in the receiver, or, if not found,
the index of the first empty slot including and after that to which the object hashes.
A pluggable <searchPolicy> is used for key comparisons and hashing."
| capacity index element |
capacity := self basicSize.
index := self hash: anObject max: capacity.
[(element := self basicAt: index) isNil
or: [searchPolicy compare: element with: anObject]]
whileFalse: [index := index \\ capacity + 1].
^index!
hash: anObject max: anInteger
^searchPolicy hash: anObject max: anInteger!
initialize
"Private - Instance variable initialization. The tally records the number of elements."
super initialize.
searchPolicy := self class defaultSearchPolicy
!
newSelection
"Private - Answer a new empty collection like the receiver to
contain a selection of the receiver's elements."
^self class searchPolicy: self searchPolicy!
preResize: newMe
"This message is sent by the receiver when resizing, before the
receiver's elements are added to newMe. We must assign across the
search policy."
newMe setSearchPolicy: self searchPolicy!
searchPolicy
"Answer the receiver's <searchPolicy>."
^searchPolicy!
searchPolicy: aSearchPolicy
"Set the receiver's <searchPolicy>."
self setSearchPolicy: aSearchPolicy.
self isEmpty ifFalse: [self rehash]!
setSearchPolicy: aSearchPolicy
"Private - Set the receiver's <searchPolicy>. Answer the receiver."
searchPolicy := aSearchPolicy.
^self!
species
"Answer the class of object to be used when copying the receiver with #collect:, etc."
^Set
! !
SharedSet comment:
'SharedSet is a process safe subclass of <Set>, which has the same behavior. It''s instances make use of a <Mutex> (a mutual exclusion lock) to prevent more than one process from accessing their elements at the same time. Although process safe to the extent that the invariants of the data structure are maintained, further synchronisation mechanisms will almost certainly be required if a <SharedSet> is used to buffer information between processes (e.g. see <SharedQueue>).
The following methods of Set are, or are not, overridden for the reasons given:
add: Overridden, public entry point
addAll: Implmented using #add:
asArray Overridden because must ensure size does not change between instantiating the new Array and the #do: loop.
asByteArray ditto
asBag Bags size affects capacity only, so not overridden.
asOrderedCollection ditto
asSet atomic (answers self)
asSortedCollection Size affects capacity only, so not overridden
asSortedCollection: ditto
at: Not permitted on sets
at:put: Ditto
capacity atomic
collect: Implemented in terms of #do:. Result will be a Set.
copyElementsInto: ditto
do: Overridden, public entry point
findElementOrNil: private, used only within methods protected by mutex (e.g. add:)
find:ifAbsent: Overidden, public entry point
fixCollisionsFrom: ditto
grow ditto (sent only from maintainLoadFactor)
identityIncludes: Overridden, public entry point
includes: Overridden, public entry point
initialize overridden, but to instantiate the mutex, not for mutual exclusion
isEmpty uses #size, which is atomic
moveFrom:to: ditto
occurrencesOf: uses #includes: and otherwise accesses no shared data
postResize: private, used only within methods protected by mutex
preResize: ditto
privateAt:put: ditto
rehash uses #resize:, and otherwise accesses no shared data
relocateElement:from: private, used only within methods protected by mutex
remove:ifAbsent: Overridden, public entry point
removeIndex: private, used only within methods protected by mutex
resize: Overridden, public entry point
shrink Overridden, public entry point
size atomic
tally atomic
uncheckedAdd: private, used only within methods protected by mutex
Instance Variables:
mutex <Mutex> for ensuring mutually exclusive access to the collection.
Class Variables:
AbsentCookie <Object>. Unique cookie used internally to signal element absence.
'!
!SharedSet class methodsFor!
initialize
"Private - Initialize the receiver's class variables.
SharedSet initialize
"
AbsentCookie := Object new! !
!SharedSet methodsFor!
add: newObject
"Include newObject as one of the elements of the receiver. Answer newObject."
^mutex critical: [super add: newObject]!
addAll: newElements
"Include all the elements of the <collection> argument, newElements, as the receiver's elements.
Answer newElements.
Implementation Note: Override to avoid overhead of acquiring mutex for each addition."
mutex critical: [newElements do: [:each | super add: each]].
^newElements!
asArray
"Answer an Array whose elements are those of the receiver (ordering is possibly arbitrary).
Must implement as critical section as otherwise Array size might be wrong."
^mutex critical: [super asArray]!
asByteArray
"Answer a ByteArray whose elements are those of the receiver (ordering is possibly arbitrary).
Must implement as critical section as otherwise the ByteArray size might be wrong."
^mutex critical: [super asByteArray]!
do: operation
"Evaluate monadic value argument, operation, for each of the elements (non-nil members)
of the receiver. Answers the receiver.
N.B. It is important that operation does not put the active process to sleep (i.e.
wait on some Semaphore) as this will prevent other Smalltalk processes from accessing
the receiver for a potentially long time, and if a weak subclass, may prevent the
removal of Corpses from taking place. In the case of weak subclasses, if the putting the
active process to sleep is unavoidable, then the weak status should be removed until
the end of the critical block (e.g. send #beStrong at the start of the block, and
#beWeakWithNotify at the end of the block)."
mutex critical: [super do: operation]!
find: target ifAbsent: exceptionHandler
"Answer the actual element of the receiver which matches (however 'match' is defined)
the argument, target. If there is no such element, then the result of evaluating the
'A LookupTable is a form of <Dictionary> that does not actually store <Assocation>s, but instead maintains parallel vectors of keys and values. This has the advantage of consuming less space and generally offering higher performance.
Dictionary behaviour involving <Assocation>s (e.g. #associationsDo:, #associationAt:) is implemented by dynamically generating associations as required. This may adversely affect performance where such behaviour is used extensively, and the transient nature of the associations may not always be appropriate. In these (rare) cases a standard Dictionary should be used.
LookupTable itself uses equality-based hashing and comparisons. The subclass IdentityDictionary and its subclasses employ identity-based hashing and comparisons.
Instance Variables:
values <Array> of values associated with the same numbered keys in the indexable instance variables of the LookupTable.'!
!LookupTable methodsFor!
add: anAssociation
"Add anAssociation to the receiver. Answer anAssociation. Unlike Dictionaries,
LookupTables do not actually store Associations, therefore we must
"Answer the class of <collection> to be used for collecting the keys of the receiver"
^IdentitySet!
searchPolicy
"Answer the receiver's <searchPolicy>."
^SearchPolicy identity! !
PluggableLookupTable comment:
'PluggableLookupTable is the class of <LookupTable>s which support a pluggable <searchPolicy>, and which can thus be configured to behave in the same way as either standard <LookupTable>s (equality search) or <IdentityDictionary>s (identity search), or indeed any user-defined search policy.
Instance Variables:
searchPolicy <searchPolicy>. The policy used to hash and compare elements of the receiver.
'!
!PluggableLookupTable class methodsFor!
defaultSearchPolicy
"Answer the default <searchPolicy> used by instances of the receiver."
^SearchPolicy equality!
new: anInteger searchPolicy: aSearchPolicy
"Answer a new instance of the receiver with an initial capacity of at least
<integer> count elements (i.e. the size is a hint), and with the specified <searchPolicy>."
'SharedLookupTable is the class of <LookupTable>s which permits only a single process to access its contents at any one time (it uses a <Mutex> object for this purpose).
Instance Variables:
mutex <Mutex>. Protection lock to guard contents.
Class Variables:
AbsentCookie <Object>. Used to identity evaluation of exception handling block.
Certain methods are not overridden for the following reasons:
add: Immediate superclass implementation use #at:put:
associationAt: Implemented in terms of #assocationAt:ifAbsent:
associationAt:ifAbsent: Implemented in terms of #at:ifAbsent:
associations Implemented in terms of associationsDo:
associationsDo: Implemented in terms of keysAndValuesDo:
at: Implemented in terms of #at:ifAbsent:
at:ifAbsent: Overridden
at:ifAbsentPut: Overridden
at:put: ditto
basicValues atomic
capacity atomic
collect: Implemented in terms of #do:, result will be a LookupTable
copyElementsInto: private, uses only within critical sections
copyEmpty Implemented in terms of #copyEmpty:
copyEmpty: Private, used only within critical sections
countElements Implemented in terms of #do:
detect: Implemented in terms of #detect:ifNone:
detect:ifNone: Implemented in terms of #do:
do: Overridden, public entry point. Revokes weak status for duration of enumeration.
emptyCheck implemented in terms of #isEmpty
errorNotFound, errorNotKeyed Don''t access shared data apart from print (uses do:)
findElementOrNil: private, used only within methods protected by mutex (e.g. add:)
findKeyOrNil: ditto
fixCollisionsFrom: ditto
grow ditto (sent only from Set>>privateAt:put:)
growSize Private, used only within critical section (not used for Set''s?)
identityIncludes: Overridden
includes: Implemented in terms of #do:
includesAssociation: Overridden
includesKey: Overridden
initialize Overridden, but to instantiate the mutex, not for mutual exclusion
inject:into: Implemented in terms of do:
inspect Debug only
intersection: Implemented in terms of select:
isEmpty uses #size == 0, which is atomic
keyAtEqualValue:ifAbsent: Overridden
keyAtValue: Implemented in terms of keyAtValue:ifAbsent:
keyAtValue:ifAbsent: Overridden
keysAndValuesDo: Overridden. Revokes weak status for duration of enumeration.
keysClass Answers constant
keys Implemented in terms of #do:
keysDo: Implemented in terms of #keysAndValuesDo:
lookupKey: For private use of compiler
maxPrint Atomic
moveFrom:to: Private, used only within critical sections
occurrencesOf: Implemented in terms of #do
printOn: Overridden
postResize: private, used only within methods protected by mutex
preResize: ditto, but must override to maintain mutex
privateAt:put: private, used only within critical sections
rehash uses #resize:, and otherwise accesses no shared data
reject: Implemented in terms of #select:
relocateElement:from: private, used only within methods protected by mutex
remove: Not valid for dictionaries
remove:ifAbsent: ditto
removeAssociation: Implemented in terms of removeKey:
removeIndex: private, used only within methods protected by mutex
removeKey: Implemented in terms of removeKey:ifAbsent:
removeKey:ifAbsent: Overridden
resize: Overridden, public entry point
shrink Overridden, public entry point
select: Implemented in terms of keysAndValuesDo:
size atomic
storeOn: Overridden
tally atomic
uncheckedAdd: Not used by dictionaries.
uncheckedAt:put: Private, used only within critical sections
values Implemented in terms of #do:
valuesClass ` Answers constant'!
!SharedLookupTable class methodsFor!
initialize
"Private - Initialize the receiver's class variable."
AbsentCookie := Object new! !
!SharedLookupTable methodsFor!
asArray
"Answer an Array whose elements are those of the receiver (ordering is possibly arbitrary).
Must implement as critical section as otherwise Array size might be wrong."
^mutex critical: [super asArray]!
asByteArray
"Answer a ByteArray whose elements are those of the receiver (ordering is possibly arbitrary).
Must implement as critical section as otherwise the ByteArray size might be wrong."
^mutex critical: [super asByteArray]!
at: key ifAbsent: exceptionHandler
"Answer the value named by the argument, key. If key is not found,
answer the result of evaluating the niladic valuable, exceptionHandler.
Implementation Note: We avoid evaluating the exceptionHandler valuable
inside the mutex to minimize the chances of throwing an exception
with the mutex locked (#critical:'s ensure block would handle the case
where the exceptionHandler performs a far return), HOWEVER this does
mean it is not entirely safe to add a new item in the ifAbsent handler
'MethodDictionary is a specialized form of <IdentityDictionary> designed for ease and speed of access by the execution machinery. As the name implies, method dictionaries are used to map method selectors to the corresponding compiled method in a particular class.
The primary difference from an ordinary identity dictionary in the current implementation is that method dictionaries are a power of 2 in size to speed up the masking of hash values to the permissible range during method lookup.
You should not rely on the implementation details of this class, and nor should you change them or the instance shape.'!
!MethodDictionary class methodsFor!
sizeFor: capacity
"Answer the <integer> size of collection that should be created to hold
the number of elements specified by the <integer> argument, capacity.
Implementation Note: Round up to the nearest power of 2, as required
by the VM, and avoid any dependency on the superclass sizing scheme."
"Answer the class of Collection to be used for collecting the keys of the receiver"
^IdentitySet!
searchPolicy
"Answer the receiver's <searchPolicy>."
^SearchPolicy identity!
species
"Answer the class of object to be used when copying the receiver. There isn't much
point answering a weak collection, as elements may expire after selection/collection, etc,
which is less than useful."
^IdentityDictionary! !
RegKey comment:
'RegKey is the class of objects which represent individual keys in the Windows Registration Database. The keys may themselves have sub-keys which are in turn represented by instances of RegKey. A RegKey is also a dictionary of registry values represented in Dolphin by instances of <RegKeyValues>.
RegKey implements the <abstractDictionary> protocol as operations against its sub-keys. In order to operate on the values under the key one must first acquire an instance of RegKeyValues using the #subValues message.'!
'A WeakSet is a <Set> which only weakly references the elements that it contains. That is, subject to the <MemoryManager>s intervention, if any of a weak set''s elements have only weak references remaining, then they may be garbage collected, in which case that weak set will receive a bereavement notification, and be given a chance to adjust to it''s loss(es), which it does by nilling out the corpses
and rehashing. Bereavement notification is performed asynchronously by separate (high priority) process, and WeakSet is accordingly a subclass of <SharedSet>.'!
!WeakSet class methodsFor!
initialize
"Initialize the receiver.
Bereavement notifications are required by the receiver's instances to
effect repairs."
self makeMourner!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #elementsExpired:;
yourself.
! !
!WeakSet methodsFor!
copyEmpty: anInteger
"Private - Answer an empty copy of the receiver, with enough space for anInteger
number of elements.
Implementation Note: We must override in order to copy the weak/strong state of
the receiver."
^(super copyEmpty: anInteger)
setSpecialBehavior: self getSpecialBehavior;
yourself!
do: operation
"Evaluate monadic value argument, operation, for each of the element of the
receiver. Answers the receiver.
Implementation Note: We override this message because if the user supplied operation
puts the active process to sleep (i.e. wait on some Semaphore) a GC may occur, losses may be
suffered, and because the mutex prevents the undertaker from entering the critical section in
#elementsExpired: we may subsequently enumerate over Corpses and treat them as elements.
In order to guard against this we temporarily revoke the receiver's status as a weak
object. Note that GC's which nil weak references can only be initiated from idle time, so
there is no danger of corpses appearing in the receiver if operation does not put the active
process to sleep."
| mask |
mutex critical: [
mask := self beStrong.
[super do: operation]
ensure: [self setSpecialBehavior: mask]]!
elementsExpired: anInteger
"Private - Handle the bereavement(s) that the receiver suffered by maintaing
the <Set> invariants (mainly that collision chains are terminated by nils)."
| deathAt capacity corpse |
corpse := DeadObject current.
mutex critical: [
capacity := self basicSize.
tally := tally - anInteger.
deathAt := self basicIdentityIndexOf: corpse from: 1 to: capacity.
(anInteger > (self size // 4))
ifTrue: [ "Rehash the collection if a large number of losses..."
[deathAt > 0] whileTrue: [
self basicAt: deathAt put: nil.
deathAt := self basicIdentityIndexOf: corpse from: deathAt+1 to: capacity].
self rehash]
ifFalse: [ "... otherwise remove the losses individually"
[deathAt > 0] whileTrue: [
self basicAt: deathAt put: nil.
self fixCollisionsIgnoringCorpsesFrom: deathAt.
deathAt := self basicIdentityIndexOf: corpse from: deathAt+1 to: capacity]]].
"Inform any dependents"
self trigger: #elementsExpired: with: anInteger!
fixCollisionsIgnoringCorpsesFrom: index
"Private - Rehashes objects in the collection after index to see if any of
them hash to index. If so, that object is copied to index, and the
process repeats with that object's index, until a nil is encountered.
Corpse objects are not relocated, on the assumption that these will
be nilled and fixed up later themselves."
| slotIndex capacity element corpse |
slotIndex := index.
capacity := self basicSize.
corpse := DeadObject current.
[slotIndex := slotIndex \\ capacity + 1.
(element := self basicAt: slotIndex) isNil]
whileFalse: [ | hashIndex |
element == corpse ifFalse: [
hashIndex := self findElementOrNil: element.
(self basicAt: hashIndex) isNil ifTrue: [self moveFrom: slotIndex to: hashIndex]]]!
initialize
"Private - Instance variable initialization. Ensure the receiver is weak."
super initialize.
self beWeak!
species
"Answer the class of object to be used when copying the receiver. There isn't much
point answering <WeakSet>, as elements may expire after selection/collection, etc,
which is less than useful, so we answer <Set>."
^Set! !
WeakIdentitySet comment:
''!
!WeakIdentitySet class methodsFor!
initialize
"Initialize the receiver.
Class initialize methods are ignored by the SourceManager unless directly implemented
so we must implement to get the bereavement notifications."
super initialize! !
!WeakIdentitySet methodsFor!
findElementOrNil: anObject
"Private - This method is a copy of IdentitySet>>findElementOrNil:"
"Answer the <RGB> colour equivalent to the receiver."
^self!
blue
"Answer the receiver's blue component (a SmallInteger in the range 0..255)."
^code bitShift: -16!
green
"Answer the receiver's green component (a SmallInteger in the range 0..255)."
^(code bitShift: -8) bitAnd: 16rFF!
printOn: aStream
"Put an ASCII representation of receiver onto aStream."
aStream
nextPut: $(;
display: self class;
display: ' red: ';
print: self red;
display: ' green: ';
print: self green;
display: ' blue: ';
print: self blue;
nextPut: $)!
red
"Answer the receiver's red component (a SmallInteger in the range 0..255)."
^code bitAnd: 16rFF!
setCode: anInteger
"Private - Set the <integer> value of the ColorRef (i.e. that value passed to API calls
to represent the color)."
code := anInteger bitAnd: 16rFFFFFF! !
COMFunction comment:
'COMFunction is the generic class of <COMFunctionAbstract> used to represent the majority of COM functions which are forwarded to the implementing <Object> (COM server) rather than the <COMObjectStub> or any other object.
Instance Variables:
selector <Symbol>. Selector to be forwarded.
descriptor <ExternalDescriptor>. Argument type descriptions.
'!
!COMFunction class methodsFor!
prototype: anExternalMethod
"Answer a new instance of the receiver appropriate for dispatching callbacks
to the argument, aCompiledMethod (which must be a callback method)."
"Private - Send an IUnknown::AddRef() call as an #AddRef message back to
the <COMObjectStub>, stub. Answer the resulting reference count.
Implementation Note: This method is called very frequently, so we have a special function
class just to improve performance."
^stub AddRef!
descriptor
"Private - Answer the descriptor object which described the external function represented
by the receiver."
^Descriptor!
selector
"Private - Answer the selector sent when the receiver is evaluated."
^#AddRef! !
UnkQIFunction comment:
'COMQueryInterfaceFunction is a specialized class of <COMFunction> intended to represent the IUnknown::QueryInterface() method.
As IUnknown is implemented entirely by the <COMObjectStub>, a COMQueryInterfaceFunction sends a #QueryInterface:ppvObject: message to the relevant stub.'!
!UnkQIFunction class methodsFor!
initialize
"Private - Initialize the receiver's class variables.
self initialize
N.B. We frequently expect E_NOINTERFACE from QueryInterface() (i.e. it is NOT an exceptional condition),
therefore we suppress the automatic exception raising provided by the virtual call primitive for
HRESULTs by declaring QueryInterface as returing a signed integer. This must then be tested explicitly.
"
Descriptor := IUnknown descriptorClass
callingConvention: IUnknown stdMethodCallType
returnType: 'sdword'
argumentTypes: 'GUID* void**'!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
'COMClassFactory is Dolphin''s standard implementation of IClassFactory. It can serve up instances of a particular coclass (possibly also a subclass of COMInterfaceImp), and having been registered once for any paricular coclass it will re-register the availability of that coclass with COM each time that Dolphin is started.
Subclasses can provide specialized services to support coclasses with particular instantiation requirements, and they can even implement alternative class factory interfaces (contrary to common believe IClassFactory is not mandatory).
Instance Variables:
serverClass - the coclass <object>. Any class which exposes COM interfaces.
clsid - the <CLSID> of the coclass.
registration - <integer> cookie supplied by COM to identify a coclass registration so that it can subsequently be revoked.
Class Variables:
Factories - previously set up <COMClassFactory> instances which, in a running image, will be registered with COM.
Instances - a <WeakSet> containing all outstanding instances of all registered coclasses. Used to control server lifetime.
LockCount - <integer> lock count reflecting calls to LockServer().
'!
!COMClassFactory class methodsFor!
basicOn: serverClass clsid: aCLSID
"Private - Answer an instance of the receiver for the specified server class and CLSID."
^self new
serverClass: serverClass;
clsid: aCLSID!
canUnloadNow
"Private - Answer whether the COM factory server is no longer in use, and can therefore
be unloaded (according to COM rules)."
^LockCount <= 0 and: [Instances isEmpty]!
clearAll
"Private - Clear down all registered instances of the receiver."
Factories do: [:f | f clear]!
decrementLockCount
"Private - Increment the server lock count."
LockCount := LockCount - 1.
LockCount <= 0
ifTrue: [self shutdownIfDead]
!
freeAll
"Private - Free all the existing class factories (revoking registrations
and removing them from the registry of factories)."
self initializeFactoryRegister!
incrementLockCount
"Private - Increment the server lock count."
LockCount := LockCount + 1
!
initialize
"Private - Initialize the receiver's instance variables.
COMClassFactory initialize
"
LockCount := 0.
self initializeFactoryRegister.
Instances := WeakSet new.
Instances when: #elementsExpired: send: #onElementsExpired: to: self!
initializeFactoryRegister
"Private - Initialize the receiver's Factory register."
Factories isNil ifFalse: [self revokeAll].
Factories := LookupTable new!
lockCount
"Answer the total class factory lock count (locks result from calls to IClassFactory::LockServer)."
^LockCount!
on: aServerClass
"Answer an instance of the receiver registered as a class factory for
manufacturing instances of aServerClass."
^self on: aServerClass clsid: aServerClass clsid!
on: serverClass clsid: aCLSID
"Answer an instance of the receiver for the specified server class and CLSID."
"Private - Answer the class for which the receiver is acting as a factory."
^serverClass!
serverClass: aClass
"Private - Record the class for which the receiver is acting as a factory."
serverClass := aClass!
supportedInterfaces
"Answer the set of interface classes supported by the receiver."
^#(##(IClassFactory))! !
COMEnumerator comment:
'COMEnumerator is Dolphin''s generic implementation of COM enumerators, i.e. IEnumXXXX. It can enumerate over any sequenceable collection of externally representable objects.
Instance Variables:
enumClass <IEnumXXXX>
contents <ReadStream>
'!
!COMEnumerator class methodsFor!
newEnumerator: enumClass on: sequence
"Answer a new COM interface which is an instance of the <IEnumXXXX> subclass, enumClass,
onto a new instance of the receiver that enumerates over the contents of the <sequencedReadableCollection>, sequence."
"Implement the IEnumXXXX::Reset() interface function.
See: Inside OLE2, Kraig Brockschmidt, Microsoft Press."
m_iCur := 0.
^S_OK!
Skip: cSkip
"Implement the IEnumXXXX::Skip() interface function.
See: Inside OLE2, Kraig Brockschmidt, Microsoft Press."
m_iCur+cSkip >= CRECTS
ifTrue: [^S_FALSE].
m_iCur := m_iCur + cSkip.
^S_OK
!
supportedInterfaces
"Answer the set of interface classes supported by the receiver."
^Array with: IEnumRECT! !
OLELockBytesAbstract comment:
'OLELockBytesAbstract is an abstract superclass which provides common behaviour for implementations of the OLE Structured Storage <ILockBytes> interface. <ILockBytes> is the abstraction used by OLE to represent an array of bytes.
'AXDualImp provides a generic implementation of IDispatch for dual interfaces with type information (i.e. a type library). It makes use of ITypeInfo''s ability to invoke the dual part of a dispatch interface when called via the late-bound IDispatch methods.
AXDualImp implements IDispatch in a very simple and efficient manner, but cannot be used for dispatch only interfaces (dispinterfaces), such as most connection points, or where no type library is available.
'AXEventSink is a generic connection point callback interface (i.e. event sink) implementation for event dispinterfaces. AXEventSink itself handles incoming events by triggering a same named Smalltalk event, the selector of which is generated from the function description in the type library. The primary keyword of the selector is the name of the event (unchanged in any way), with subsequent keywords the name of the corresponding argument from the library, or just an underscore & colon pair (_:) if the argument is unnamed. In-only arguments are converted from the variant parameter to the equivalent Smalltalk object, whereas output arguments are passed around as a <VARIANT> which can be updated with the value to pass out.
AXEventSink implements <IDispatch> (mostly via inheritance), but only the Invoke() method. All other methods are associated with requesting type information about the interface, which it wouldn''t make sense for the caller to do, since it defines the interface and ought therefore to be well aware of its specification.
Note that COM components "source" interfaces are almost always dispinterfaces because VB is restricted to this type, although connection point interface can be vtbl based interfaces too. Some components (e.g. ADO) support both types. Where an event interface is specified as a dual it can be more efficiently implemented using <AXForwardingDualImp>. Where a custom interface is employed, this can simply be implemented against the object which is to receive the events.
Set the receiver's upperBound from the [in] parameter, value."
upperBound := value.
^S_OK! !
COMSingletonClassFactory comment:
'COMSingletonClassFactory is simple specialization of COMClassFactory which always serves up the same instance of its registered coclass.
Note that although this is a useful concept (it is supported by the ATL for example), it is not strictly supported by COM which expects every call to CoCreateInstance() to answer a brand new instance of the coclass. This can break the apartment threading model when sharing an object since COM assumes that the object is created in the apartment of the caller, and where multiple apartments exist this can result in one apartment erroneously holding an unmarshalled interface pointer to an object in another apartment.
Dolphin''s standard implementation of IClassFactory. It can serve up instances of a particular coclass (possibly also a subclass of COMInterfaceImp), and having been registered once for any paricular coclass it will re-register the availability of that coclass with COM each time that Dolphin is started.
Instance Variables:
current - the lazily instantiated singleton instance of the receiver''s coclass.
Class Variables:
None
'!
!COMSingletonClassFactory methodsFor!
createInstance: pUnkOuter
"Private - Answer the singleton instance of the receiver's server class."
current isNil ifTrue: [
current := super createInstance: pUnkOuter].
^current! !
COMInterfaceEnumerator comment:
'COMInterfaceEnumerator is Dolphin''s generic implementation of COM enumerators for collections of interface pointers, i.e. IEnumUnknown.
'!
!COMInterfaceEnumerator class methodsFor!
newEnumeratorOn: sequence
"Answer a new <IEnumUnknown> onto a new instance of the receiver
that enumerates over the contents of the <sequencedReadableCollection>,
sequence."
^self newEnumerator: IEnumUnknown on: sequence! !
!COMInterfaceEnumerator methodsFor!
arrayBufferAt: buf length: count
"Private - Answer a suitable <ExternalArray> wrapping the buffer at <ExternalAddress>,
buf, of <integer> length, count."
^DWORDArray fromAddress: buf length: count
!
nextElement
"Private - Answer a copy of the next element of the receiver.
Implementation Note: We must add a reference as we are copying
interface pointers into an output argument."
| pi |
pi := contents next.
pi _addRef.
^pi yourAddress
! !
COMVariantEnumerator comment:
'COMInterfaceEnumerator is Dolphin''s implementation of <IEnumVARIANT>.'!
'OLELockBytes is an implementation of the ILockBytes interface on a Smalltalk <ByteArray>. It is primarily intended for testing and development purposes (it is a handy way to see exactly what is being written to a stream), and also as an example implementation of a system COM interface.
OLELockBytes is similar to the system provided ILockBytes implementation on top of a global memory handle, except that the underlying storage mechanism is a ByteArray and it is somewhat slower. It doesn''t support locking.'!
'OLELockFileBytes is an implementation of the <ILockBytes> interface on to an arbitrary <File>. It is useful because the system does not provide a standard implementation of ILockBytes against a file, which makes it difficult to connect an <IStream> to an arbitrary file without first copying its contents into a global memory block.'!
'ClosedCommandDescription is the class of <CommandDescription>s that have a pluggable implementation of #queryCommand: such that they can be completely self contained, both describing the command to be performed, where to send it, and also managing enablement/disablement.
Instance Variables:
queryBlock <monadicValue> implementation of #queryCommand:. Can be nil.
receiver <Object> to which the command will be sent. Can be nil, in which case queryBlock determines receiver.
"Answer a <Collection> of all the method protocols in which the receiver is included."
^self methodClass allProtocols select: [:p | p includesSelector: self selector]
!
realCategories
"Answer a <Collection> of all the 'real' (i.e. non-virtual) method categories in which
the receiver is included. Note that this does include the public/private categories."
^self methodClass realCategoriesOfMethod: self!
recompile
"Private - Recompile the receiver."
self methodClass recompile: self selector!
storeCategories
"Private - Record the categories of the receiver.
The job is simply delegated to the receiver's source manager."
self class sourceManager storeCategoriesForMethod: self.!
storeSourceString: aString
"Private - Record aString as the source for the receiver. Delegate to the receiver's source manager"
self class sourceManager storeSourceString: aString forMethod: self! !
CompileFailedMethod comment:
'In certain situations (package loading, method dropping etc) a method compilation will fail and yet a stub CompileFailedMethod is still installed in the class. This stub is useful since it allows the original method source to be accessible via the browsers and allows category information to be maintained for the failed method.
If you want to locate all of these compilation failures remaining in your image siimply evaluate:
SmalltalkSystem current browseCompileFailedMethods'!
!CompileFailedMethod class methodsFor!
icon
"Answer an Icon representing the receiver."
^##(self) defaultIcon! !
!CompileFailedMethod methodsFor!
accessesInstVar: aString at: anInteger
"Answer whether the receiver accesses the instance variable named, aString, which
is the instance variable of its method class with the specified <integer> index."
^self refersToVariable: aString!
asDebugMethod
"Private - Answer a debug version of the receiver with breakpoints after each
expression/statement."
^self!
icon
"Answers an Icon that can be used to represent this class"
^self class icon
!
isCompilationFailure
^true! !
ExternalMethod comment:
'ExternalMethod is the class of primitive <CompiledMethod>s which represent native, or external, function calls, such as those in the Win32 API. ExternalMethods mediate between the dynamically typed Smalltalk world of objects and the static value based world of C prevailing elsewhere.
The first literal of each ExternalMethod holds a <ByteArray> which contains a descriptor for the function call. The byte array format is understood by the <ExternalDescriptor> class, but essentially there are details of the return and argument types, the name of function, and space to cache the procedure address.
'!
!ExternalMethod class methodsFor!
initialize
"Private - Initialize the receiver's class variables.
'A DolphinSureCertificate can be used when signing a piece of DolphinSureTrustedData. It can be used to guarantee that the trusted data is from a particular publisher and because it contains a public key that is used to encode the data one can feel confident that the data has not been modified in transit. Note that, a DolphinSureCertificate is also trusted data itself. This prevents an attacker from forging the certificate.
If you wish to be able to make use of DolphinSureTrustedData within your applications, either directly or when you wish to digitally sign Dolphin web applets, then you will need to apply for a publisher''s certificate. These are available from Object Arts Ltd at http://www.object-arts.com/DolphinSure.'!
'A DolphinSureCertificationAuthorityCertificate instance is used to represent a certificate that can be used by a DolphinSure certifying authority to issue standard DolphinSureCertificates for publishers.'!
'A NotSignedCertificate is used to indicate when a piece of data has not been digitally signed using DolphinSure. Typically it is used by BinaryPackage>>loadUsing: when a binary class file is being loaded and it is discovered that the class data has not been signed.
Although it may seem strange to have a certificate for this purpose, it does allow the user to elect to install the NotSignedCertificate in his or her temporary trust store. By doing so, a user can avoid repeated warnings about loading unsigned classes for the duration of the current Dolphin session. The temporary trust store is cleared out whenever an image is started so unsigned classes cannot be trusted indefinitely.'!
"Private - Answer the number of years that certificates of this class should be valid
for by default. Nil indicates valid indefinitely."
^nil! !
!ObjectArtsInstallerCertificate methodsFor!
purpose
"Answers the purpose of this certificate"
^'This certificate ensures that a product installation is genuine and has not been tampered with.'! !
ObjectArtsRootCertificate comment:
'The ObjectArtsCertificate class is used to represent the root DolphinSure certifying authority certificate for Object Arts Ltd. The actual encoded certificate data is held in the #new class method. We specially include this class here to act as the root of the DolphinSureTrustedData trust hierarchy.
If you wish to display the Object Arts root certificate, you can evaluate:
"Private - Initialize the receiver's instance variables. Answer the receiver."
message := WM_PAINT.
hWnd := anExternalHandle.
wParam := anInteger.
lParam := 0.
hdc := dcExternalHandle.
paintStruct := aPAINTSTRUCT!
paintStruct
"Answer the <PAINTSTRUCT> associated with the receiver."
^paintStruct!
printOn: aStream
"Append a textual representation of the receiver to aStream."
aStream
basicPrint: self;
nextPut: $(;
print: self paintStruct;
nextPut: $)! !
PointEvent comment:
''!
!PointEvent methodsFor!
position
"Private - Answer the point stored in the receiver's lParam."
^self x @ self y!
screenPosition
"Answer the point stored in the receiver's lParam mapped to screen coordinates"
^self window mapPoint: self position to: View desktop!
x
"Answer the x-position of the pointer."
^self lParamX!
y
"Answer the y-position of the pointer."
^self lParamY! !
PositionEvent comment:
'PositionEvent is the class of <Event> associated with a window reposition event originating from a WM_WINDOWPOSCHANGING or WM_WINDOWPOSCHANGED message.'!
!PositionEvent class methodsFor!
fromMSG: aMSG
"Answer an instance of the receiver instantiated from the Win32 message, aMSG."
^(super fromMSG: aMSG) makeStruct! !
!PositionEvent methodsFor!
extent
"Answer the extent of the window after the size event.
N.B. This is not the width of the client area, but the external dimension.
If the client area is required, it can be requested by simply sending an
#clientExtent message to the window."
^self width @ self height!
extent: aPoint
"Set the extent of the window for the size event.
N.B. This is not the width of the client area, but the external dimension."
self width: aPoint x; height: aPoint y!
flags
"Answer an <integer> containing the SWP_XXX flags associated with
this position change event."
^lpwp flags!
height
"Answer the height of the window after the size event.
N.B. This is not the height of the client area, but the external dimension.
If the client area is required, it can be requested by simply sending an
#clientExtent message to the window."
^lpwp cy!
height: anInteger
"Set the height of the window for the size event.
N.B. This is not the height of the client area, but the external dimension."
^lpwp cy: anInteger!
isActivate
"Answer whether the receiver is describing a window activation event."
^lpwp flags noMask: SWP_NOACTIVATE!
isMove
"Answer whether the receiver is describing a move event."
^lpwp flags noMask: SWP_NOMOVE!
isRectangleChanged
"Answer whether the receiver is describing a position change
event which has really affected the layout of the window."
"Answer a String representation of the OS error code."
^self hresult displayString!
source
"Answer the 'source' of the error (by convention the Prog ID of the component which raised the error).
This is only available if extended error information is associated with the receiver."
^errorInfo notNull ifTrue: [errorInfo source]!
statusCode
"Answer the error status code from the receiver's details."
^self hresult statusCode! !
InvalidExternalCall comment:
'Exception to represent an invalid attempt to invoke an external procedure call, perhaps because of passing an invalid object type as an argument.
See <ExternalDescriptor>''s class comment for a description of the argument types supported by Dolphin.'!
!InvalidExternalCall class methodsFor!
invalidArgument: anInteger got: anObject expected: type
"Private - Validate the attempted invocation of the ExternalMethod in
the StackFrame argument, raising an appropriate Error if validation of an
argument fails."
##(ExternalDescriptor initialize). "cause ExternalDescriptor to be initialized during boot"
^self new
argument: anObject;
type: type;
signalWith: anInteger! !
!InvalidExternalCall methodsFor!
_descriptionArguments
"Answer the set of arguments to be substitued into the receiver's descriptionFormat
String."
^super _descriptionArguments,
(Array
with: argument basicPrintString
with: type displayString)!
_descriptionFormat
"Private - Answer a string which is the message format for the receiver's description.
Implementation Note: Parameter 1 is the message text, which we don't use in this
case, 2 is the index of the offending argument, 3 the object passed, and 4 the type
expected."
^'Invalid arg %2: Cannot coerce %3 to %4'!
argument: anObject
"Private - Set the arguments passed to the invalid call which the receiver represents to anArray."
argument := anObject!
type: anObject
"Private - Set the type expected by the argument for which the receiver represents an
invalid call to anObject."
type := anObject! !
InvalidFormat comment:
''!
!InvalidFormat methodsFor!
_descriptionFormat
"Private - Answer a string which is the message format for the receiver's description."
^'Invalid format for %2'! !
InvalidInstallationError comment:
''!
!InvalidInstallationError methodsFor!
_descriptionFormat
"Answer the Win32 format String to be used to format the description for the receiver."
^'This copy of Dolphin Smalltalk has not been installed correctly; please re-install from the original source medium.'
! !
MessageNotUnderstood comment:
''!
!MessageNotUnderstood class methodsFor!
receiver: anObject message: aMessage
"Raise a new instance of the receiver reporting that the <object>, anObject, did not understand
the <failedMessage>, aMessage."
^super new
receiver: anObject;
tag: aMessage;
signal! !
!MessageNotUnderstood methodsFor!
_descriptionArguments
"Answer an string describing the extra information supplied when the receiver
was raised. Here we answer the classic does not understand error."
^Array with: self receiver basicClass name with: self selector printString!
_descriptionFormat
"Answer the Win32 format String to be used to format the description for the receiver.
We answer the classic does not understand error format."
^'%1 does not understand %2'!
isResumable
"Answer whether the receiver represents a resumable error. Message not understood errors are
considered resumable, as there are a number of circumstances in which we might want to
perform #doesNotUnderstand: handling and continue."
^true!
message
"Answer the <failedMessage> associated with the receiver."
^self tag!
receiver
"Answer the object which did not understand the receiver's
<failedMessage>."
^receiver!
receiver: anObject
"Set the object which did not understand the message to be anObject"
receiver := anObject!
selector
"Answer the selector that was not understood from the receiver's
<failedMessage>."
^self message selector! !
NotFoundError comment:
''!
!NotFoundError methodsFor!
_descriptionFormat
"Answer the Win32 format String to be used to format the description for the receiver."
^'Not found: %2'!
receiver
"Answer the object which generated the error."
^receiver!
receiver: anObject
"Set the object which generated the error to be anObject"
receiver := anObject! !
NotTrustedError comment:
'A NotTrustedError is signalled to indicate when the load of a binary class file has been prevented by the end-user due to a lack of trust in the publisher of the class. It is either signalled when a digital certificate for a signed class has been refused (in SignedClassStub>>reifyClassUsing:) or when an unsigned class is being loaded and the standard NotSignedCertificate has been refused instead.
Normal policy is to let the error propagate unimpeded and, either bring up a walkback in the development system, or display a warning MessageBox in a run-time system. However, one might consider trapping this error and performing some other action when an untrusted class load is refused.'!
"Answer an <Interval> specifying the range of character positions in the source text
to which the error applies."
^range!
source
^source! !
STBError comment:
''!
!STBError methodsFor!
_descriptionFormat
"Answer the Win32 format String to be used to format the description for the receiver."
^'STBFiler - %1'! !
SubclassResponsibilityError comment:
''!
!SubclassResponsibilityError methodsFor!
hresult
"Answer the <HRESULT> error code associated with the receiver.
Overridden by subclasses to answer more specified HRESULT codes."
^HRESULT notImplemented!
initialize
"Private - Initialize the receiver's instance variables"
messageText := 'Not implemented'! !
TestFailure comment:
'Signaled in case of a failed test (failure). The test framework distinguishes between failures and errors. A failure is anticipated and checked for with assertions. Errors are unanticipated problems like a division by 0 or an index out of bounds'!
TrustedDataError comment:
'A TrustedDataError is signalled if an instance of DolphinSureTrustedData cannot correctly decode its contents. This is probably an indication that the trusted data has been tampered with in transit.'!
"Answer the Win32 format String to be used to format the description for the receiver."
^'%4 %7 0x%8!!X!!, IP 0x%5!!X!! (%6)'! !
ResumableTestFailure comment:
'A ResumableTestFailure triggers a TestFailure, but lets execution of the TestCase continue. This is useful when iterating through collections, and #assert: ing on each element. In combination with methods like TestCase>>#assert:description:, this lets you run through a whole collection and note which tests pass.
Here''s an example:
aCollection do: [ :each |
self assert: each isFoo description: each printString resumable: true]
For each element where #isFoo returns <false>, the element will be printed to the Transcript. '!
!ResumableTestFailure methodsFor!
isResumable
"Of course a ResumableTestFailure is resumable ;-)"
^true
!
sunitExitWith: aValue
self resume: aValue
! !
CompilerNotification comment:
''!
!CompilerNotification class methodsFor!
beep
"Sound a beep describing the severity of the notification."
self severityClass beep!
icon
"Answer the default icon for the receiver and its instances."
"Answer the Win32 format String to be used to format the description for the receiver."
^'HRESULT Success: %2 (%3)'!
hresult
"Answer the HRESULT error code associated with the receiver."
^self tag! !
MethodCompileFailed comment:
'A MethodCompileFailed notification is signalled when a method compilation fails. Handlers can trap this if they wish to replace the original failed compilation with a stub method. This is useful so that the failed method source can be seen in the browsers or to retain category information. To install a stub method the handler should call #resumeWithStubMethod.'!
!MethodCompileFailed class methodsFor!
new
"Private - Use #with:"
self shouldNotImplement!
with: aCompilerErrorNotification
"Answer an instance of the receiver that indicates that a method compilation failed
due to aCompilerErrorNotification"
^super new compilerErrorNotification: aCompilerErrorNotification
"First create a method definition with the correct parameters"
keywords := selector keywords.
(argc := selector asSymbol argumentCount) == 0
ifTrue: [definitionStream nextPutAll: selector]
ifFalse:
[(argc == 1 and: [selector isInfix])
ifTrue:
["Assume a binary selector"
definitionStream
nextPutAll: selector;
nextPutAll: ' operand']
ifFalse:
[| argNameStem argNames argName |
argNameStem := 'arg'.
argNames := Set withAll: methodClass allInstVarNames.
keywords do:
[:keyword |
| x |
definitionStream
nextPutAll: keyword;
space.
x := 1.
[argName := argNameStem , (x := x + 1) displayString.
argNames includes: argName]
whileTrue.
argNames add: argName.
definitionStream
nextPutAll: argName;
space]]].
"Now compile the source into a CompileFailedMethod"
definitionStream
cr;
nextPutAll: ' self error: ''This method did not compile'''.
result := methodClass compilerClass
compile: definitionStream contents
in: methodClass
flags: 0.
result method becomeA: CompileFailedMethod.
"Resume with this stub"
self resume: result! !
RaisedNotificationSignal comment:
'RaisedNotificationSignal is the class of Error whose instances are used to represent NotificationSignal instances when raised. That is it enables instance based notifications (NotificationSignals) to be raised within Dolphin''s class based exception framework.
Instances Variables:
signalType <Signal>. The signal instance which originated this exception.'!
!RaisedNotificationSignal methodsFor!
_descriptionFormat
"Answer the Win32 format String to be used to format the description for the receiver -
we delegate this back to the Signal instance we are representing."
^self signalType description!
defaultAction
"The receiver is an unhandled notification, perform the default action
(forward to the SessionManager for application customisation)."
^self signalType defaultAction: self!
isResumable
"Answer whether the receiver represents a resumable error. This depends on the originating Signal."
^self signalType isResumable!
signalType
"Private - Answer the instance of Signal for which the receiver is representing
a raise event."
^signalType!
signalType: aSignal
"Private - Set the instance of Signal for which the receiver is representing
a raise event."
signalType := aSignal! !
Warning comment:
'Warning is the class of <Notification>s which represent exceptional conditions that are not considered errors, but which should still be reported to the user with the option to continue or abort the computation.'!
!Warning class methodsFor!
beep
"Sound an appropriate beep to draw the users attention."
Sound warningBeep!
icon
"Answer the default icon for the receiver and its instances."
^Icon warning!
severityClass
"Answer an exception class describing the severity of the notification."
^Warning! !
!Warning methodsFor!
defaultAction
"Perform the default action for the receiver if it is not handled
(forward to the SessionManager for application specific handling).
N.B. The ANSI standard states that the user should be given the option to
either continue or abort the computation, and indeed that is what the
standard SessionManager implementation does. "
"Will not return unless execution is to be resumed"
^SessionManager current onUnhandledWarning: self! !
CompilerErrorNotification comment:
''!
!CompilerErrorNotification class methodsFor!
beep
"Sound a beep describing the severity of the notification."
Sound woofFor: #onCompileFailed ifAbsent: [ super beep ].
!
severityClass
"Answer an exception class describing the severity of the notification."
^Error! !
CompilerWarningNotification comment:
''!
!CompilerWarningNotification class methodsFor!
severityClass
"Answer an exception class describing the severity of the notification."
^Warning! !
ExceptionHandler comment:
''!
!ExceptionHandler methodsFor!
actionFor: exception
"Private - Answer a <monadicBlock> handler for the <exceptionDescription>
argument, exception or nil if the receiver has no appropriate handler."
^(selector handles: exception) ifTrue: [handler]!
on: exceptionSelector do: monadicBlock
"Private - Record the <exceptionSelector> and <monadicBlock> to be
used as the receivers exception selector and handler block respectively."
selector := exceptionSelector.
handler := monadicBlock
! !
ExceptionHandlerSet comment:
''!
!ExceptionHandlerSet class methodsFor!
new
"Answer a new, initialized, instance of the receiver."
^super new initialize! !
!ExceptionHandlerSet methodsFor!
actionFor: exception
"Private - Answer a <monadicBlock> handler for the <exceptionDescription>
argument, exception or nil if the receiver has no appropriate handler."
HANDLE hEventLog, // handle returned by RegisterEventSource
WORD wType, // event type to log
WORD wCategory, // event category
DWORD dwEventID, // event identifier
PSID lpUserSid, // user security identifier (optional)
WORD wNumStrings, // number of strings to merge with message
DWORD dwDataSize, // size of binary data, in bytes
LPCTSTR *lpStrings, // array of strings to merge with message
LPVOID lpRawData // address of binary data
);"
<stdcall: bool ReportEventA handle word word dword lpvoid word dword lpvoid lpvoid>
^self invalidCall! !
ComDlgLibrary comment:
'ComDlgLibrary is the <ExternalLibrary> class to represent the Win32 system DLL, COMDLG32.DLL.
This DLL implements Windows'' standard "common" dialogs, such as the File Open/Save, Find, Find/Replace, Font, Color and Print dialogs. See subclasses of <CommonDialog>, which wrap these behind a Smalltalk API in Dolphin.'!
!ComDlgLibrary class methodsFor!
fileName
"Answer the host system file name for the library"
^'COMDLG32'! !
!ComDlgLibrary methodsFor!
chooseColor: aWinCHOOSECOLOR
"Create a Color common dialog box that enables the user to select a color.
BOOL ChooseColor(
LPCHOOSECOLOR lpcc // address of structure with initialization data
);"
<stdcall: bool ChooseColorA lpvoid>
^self invalidCall!
chooseFont: aWinCHOOSEFONT
"Create a Font common dialog box that enables the user to choose attributes for a logical font.
These attributes include a typeface name, style (bold, italic, or regular), point size, character set, and
effects (underline, strikeout, and text color).
BOOL ChooseFont(
LPCHOOSEFONT lpcf // address of structure with initialization data
);"
<stdcall: bool ChooseFontA lpvoid>
^self invalidCall
!
commDlgExtendedError
"The CommDlgExtendedError function returns a common dialog box error code.
This code indicates the most recent error to occur during the execution of one of
the common dialog box functions."
<stdcall: dword CommDlgExtendedError>
^self invalidCall
!
findText: aWinFINDREPLACE
"Create a system-defined modeless dialog box that lets the user specify a string to search for and options to
use when searching for text in a document.
HWND FindText(
LPFINDREPLACE lpfr // address of structure with initialization data
"Answer the title of the file identified by the lpszFile parameter.
short GetFileTitle(
LPCTSTR lpszFile, // pointer to full path and filename for file
LPTSTR lpszTitle, // pointer to buffer that receives filename
WORD cbBuf // length of buffer
);"
<stdcall: sword GetFileTitleA lpstr lpstr word>
^self invalidCall!
getOpenFileName: aWinOPENFILENAME
"Creates an Open common dialog box that lets the user specify the drive, directory, and the name
of a file or set of files to open.
BOOL GetOpenFileName(
LPOPENFILENAME lpofn // address of structure with initialization data
);"
<stdcall: bool GetOpenFileNameA lpvoid>
^self invalidCall!
getSaveFileName: aWinOPENFILENAME
"Creates a Save common dialog box that lets the user specify the drive, directory,
and name of a file to save.
BOOL GetSaveFileName(
LPOPENFILENAME lpofn // address of structure with initialization data
);"
<stdcall: bool GetSaveFileNameA lpvoid>
^self invalidCall
!
printDlg: aWinPRINTDLG
"Displays a Print dialog box or a Print Setup dialog box. The Print dialog box enables the user to
specify the properties of a particular print job.
BOOL PrintDlg(
LPPRINTDLG lppd // address of structure with initialization data
);"
<stdcall: bool PrintDlgA lpvoid>
^self invalidCall
!
replaceText: aWinFINDREPLACE
"Create a system-defined modeless dialog box that lets the user specify
a string to search for and a replacement string, as well as options to
control the find and replace operations.
HWND ReplaceText(
LPFINDREPLACE lpfr // address of structure with initialization data
);"
<stdcall: handle ReplaceTextA lpvoid>
^self invalidCall
!
systemError
"Generate an error based on the last recorded host system error."
^self systemError: self commDlgExtendedError! !
CommCtrlLibrary comment:
'CommCtrlLibrary is an <ExternalLibrary> to represent the Windows Common Controls Library, COMCTL32.DLL. This library implements the "newer" (post-Windows 95) controls such as the ListView and TreeView, with recent additions (known collectively as the IE4 controls) such as the DateTimePicker. A notable exception is the RichEdit control, which is implemented in its own library.
Dolphin requires at least version 4.70 of this library (previous versions were supported by some older versions of Dolphin, but you must now upgrade to the latest DLL, which is available as a free download from Microsoft).'!
!CommCtrlLibrary class methodsFor!
closeDefault
"Private - Close the default instance of the receiver (if there is one).
Implementation Note: As a temporary bodge, don't actually unload the library
when discarding the default instance because to do so causes problems with the
ImageStripperProgress dialog (which uses one of the common control classes).
My guess is that unloading the library unregisters the common control window
classes, which for some reason causes a subsequent GPF in the progress bar."
default := nil!
fileName
"Answer the host system file name for the library."
^'COMCTL32'!
initialize
"Private - Initialize the receiver's class variables.
"Initialize the receiver as specified by the init struct argument."
<stdcall: bool InitCommonControlsEx void* >
^self invalidCall!
initialize
"Private - Initialize and answer the receiver.
Implementation Note: The INITCOMMONCONTROLSEX external structure class has been
removed from Dolphin 4, as we can hardly justify having a class just for this purpose."
| struct |
struct := ByteArray new: 8.
struct
dwordAtOffset: 0 put: 8;
dwordAtOffset: 4 put: InitFlags.
self initCommonControlsEx: struct! !
CompilerLibrary comment:
'CompilerLibrary is the <ExternalLibrary> to represent the Dolphin Smalltalk compiler.
In versin 3.0 the compiler is actually implemented as a COM object, but to avoid the necessity of making the OLE COM package part of the base image, the VM exposes some simple wrapper functions which have the same signature as the 2.x compiler API.'!
!CompilerLibrary class methodsFor!
fileName
"Answer the host system file name of the external library which
'DolphinSureCryptoLibrary is the ExternalLibrary class to represent the DolphinSureCrypto DLL. It contains cryptographic functions, currently to implement the Secure Hash Algorithm (SHA) described in the U.S. government''s Secure Hash Standard (SHS). This standard is described in FIPS PUB 180-1, "SECURE HASH STANDARD", April 17, 1995. The algorithm contained in this DLL was implemented from the description on p. 442 of ''Applied Cryptography: Protocols, Algorithms, and Source Code in C'' by Bruce Scheier, Wiley, 1996.'!
'ExternalResourceLibrary is a generic type of <ExternalLibrary>, instance of which can be used to access resources (e.g. icons, bitmaps, strings) from arbitrary modules (DLLs and EXES). A registry of open resource libraries is maintained so that each module is represented by a single instance, and aliasing of the library names is supported to map old Dolphin resources to new libraries should the latter be renamed.'!
!ExternalResourceLibrary class methodsFor!
aliasFor: libraryNameString
"Answer the name of the resource file which should actually be opened in place
of the named library. Generally the argument will be answered, but on occassion, e.g
after a product upgrade, the resource file name has changed and so we can use
this facility to remap old resources to the new resource file."
"Answer the host system file name of the external library which the
receiver represents"
^'msimg32'! !
!Msimg32Library methodsFor!
alphaBlend: hdc nXOriginDest: x nYOriginDest: y nWidthDest: w nHeightDest: h hdcSrc: hdcSrc nXOriginSrc: sx nYOriginSrc: sy nWidthSrc: sw nHeightSrc: sh blend: blendOp
"Copy a bitmap from a source rectangle into a destination rectangle, using alpha blendingstretching or
compressing it to fit the dimensions of the destination rectangle, if necessary. Windows
stretches or compresses the bitmap according to the stretching mode currently set in
the destination device context.
BOOL AlphaBlend(
HDC hdcDest, // handle of destination device context
int nXOriginDest, // x-coordinate of upper-left corner of dest. rect.
int nYOriginDest, // y-coordinate of upper-left corner of dest. rect.
int nWidthDest, // width of destination rectangle
int nHeightDest, // height of destination rectangle
HDC hdcSrc, // handle of source device context
int nXOriginSrc, // x-coordinate of upper-left corner of source rectangle
int nYOriginSrc, // y-coordinate of upper-left corner of source rectangle
p ¬╕'┼#π▐ê祃NÆ╪─Ωµ<┐j≥6┘ZRaJFOµ9╙½/j₧8ÜO╤FKp╞trÿ■{úgO1ó╦åd k)Wû5╥╫·Vü≈Y╛ⁿ]èçÜn╨(1BE╓╕IiT°º╥√µ*ëë╥ⁿï¢φPÆLäüVUh═°µzóêDO1▀■ó╟╠;=·≡E╬ß╥{>ê╣²öN<Zgε║|╩o░┼}╞τ¡D£┤E⌐qDmΘΘ╬âD╗¥·W╩ö^Γ╡h~Ωⁿ╩╬å ]Pè'┼ö╤O=▀┼╬Cƒ≥ë{Gï╥7·+7«₧Da╔`▌≈Ö½¥|Φ ç┐╨â«╥J╓m
"Get a pointer to the class factory of a COM class whose CLSID is, clsid, querying the interface with IID, iid, and answering it through the [out] parameter, ppv.
HRESULT CoGetClassFactory(
REFCLSID rclsid, //Class identifier (CLSID) of the object
DWORD dwClsContext, //Context for running executable code
COSERVERINFO* pServerInfo,
REFIID riid, //Reference to the identifier of the interface
LPVOID *ppv //Indirect pointer to requested interface
'PermanentLibrary is the class of <ExternalLibrary>s which are expected to remain permanently open in order for the system to continue functioning. The set of permanent libraries includes all of the basic Win32 system DLLs, the C runtime library, and the Virtual Machine itself. In addition these are not opened lazily to avoid the overhead when accessing the default instance.'!
!PermanentLibrary class methodsFor!
clear
"Private - Clear down cached external function addresses from previous runs."
'CRTLibrary is the <ExternalLibrary> class to represent the MS C run-time library, MSVCRT.DLL.
The C runtime library is linked with the VM and is therefore permanently available. It provides many useful services (some of which are not wrapped at present) and is used quite extensively by the base image to avoid re-inventing the wheel and to keep the image size down.
If there is a function of the C runtime library which you wish to make use of then you should add it using the existing methods as a guide. It is possible to call vararg functions, but you may need to add a number of methods with increasing numbers of arguments. Note that all the functions use the cdecl calling convention.'!
!CRTLibrary class methodsFor!
fileName
"Answer the host system file name for the external library the
receiver represents."
^File splitStemFrom: (self default fileName)!
open
"Answer a new instance of the receiver to represent the CRT DLL."
"Private - Synchronize the CRT's locale with the OS locale setting."
| buf |
self setlocale: 0 locale: ''.
buf := String new: 10.
buf := self _gcvt: Float zero count: 2 buffer: buf.
decimalSeparator := buf copyFrom: 2
!
tan: aFloat
"Answer the Tangent of the argument, aFloat."
<cdecl: double tan double>
^self invalidCall!
ungetc: c stream: stream
"Pushes the character with integer code point, c, back onto the FILE*, stream."
<cdecl: sdword ungetc sdword handle>
^self invalidCall!
wcscspn: aUnicodeString strCharSet: strCharSet
<cdecl: dword wcscspn lpvoid lpwstr>
^self invalidCall! !
GDILibrary comment:
'GDILibrary is the <ExternalLibrary> class to represent the Windows system DLL, GDI32.DLL.
The default instance of this class provides access to most of the Win32 graphics API. New functions may be added as required, but the external function naming convention should be followed.
All functions in this library use the stdcall calling convention.'!
!GDILibrary class methodsFor!
fileName
"Answer the host system file name of the external library which the
receiver represents"
^'GDI32'! !
!GDILibrary methodsFor!
beginPath: hdc
"The BeginPath function opens a path bracket in the specified device context.
BOOL BeginPath(
HDC hdc // handle to device context
);"
<stdcall: bool BeginPath handle>
^self invalidCall!
bitBlt: hdc nXDest: x nYDest: y nWidth: w nHeight: h hdcSrc: hdcSrc nXSrc: sx nYSrc: sy dwRop: rop
"Perform a bit-block transfer of the color data corresponding to a rectangle
of pixels from the specified source device context into a destination device context.
BOOL BitBlt(
HDC hdcDest, // handle to destination device context
int nXDest, // x-coordinate of destination rectangle's upper-left corner
int nYDest, // x-coordinate of destination rectangle's upper-left corner
int nWidth, // width of destination rectangle
int nHeight, // height of destination rectangle
HDC hdcSrc, // handle to source device context
int nXSrc, // x-coordinate of source rectangle's upper-left corner
int nYSrc, // y-coordinate of source rectangle's upper-left corner
'KernelLibrary is the <ExternalLibrary> which represents the Win32 System DLL, KERNEL32.DLL.
The default instance of this class provides access to most of the base operating system services. New functions may be added as required, but the external function naming convention should be followed.
KernelLibrary is a special case in that its handle is cached by the VM on startup into the VM registry, and it is the means by which all other libraries are opened.
All functions in this library use the stdcall calling convention.'!
!KernelLibrary class methodsFor!
clear
"Private - Clear down cached external function addresses and any default
instances of the receiver from previous runs. etc."
super clear.
OSVERSIONINFO clear
!
fileName
"Answer the host system file name of the external library which
the receiver represents."
^'KERNEL32'!
open
"Answer a new instance of the receiver to represent the Kernel32 DLL. Special handling
is required for this library because opening a library is normally done through the
receiver's singleton instance. The VM stores the current Kernel32 handle into the
getAtomName: id lpBuffer: aString nSize: anInteger
"The GetAtomName function retrieves a copy of the character string associated with the specified local atom.
This function replaces the GetAtomHandle function.
UINT GetAtomName(
ATOM nAtom, // atom identifying character string
LPTSTR lpBuffer, // address of buffer for atom string
int nSize // size of buffer
);
Return Value
If the function succeeds, the return value is the length of the string copied to the buffer, in characters, not including the terminating null character.
If the function fails, the return value is zero. To get extended error information, call GetLastError."
<stdcall: dword GetAtomNameA word lpstr sdword>
^self invalidCall
!
getCommandLine
"Answer a pointer to the command-line string.
LPTSTR GetCommandLine(VOID)"
<stdcall: lpstr GetCommandLineA>
^self invalidCall!
getComputerName: buffer nSize: pBufSize
"Retrieves the computer name of the current system into the argument, buffer (which must be large
enough to contain MAX_COMPUTERNAME_LENGTH+1 characters). Answers whether the name
was successfully retrieved. If successful then the value of pBufSize will be the number of characters
in the name.
BOOL GetComputerName(
LPTSTR lpBuffer, // address of name buffer
LPDWORD nSize // address of size of lpBuffer
);"
<stdcall: bool GetComputerNameA lpstr DWORD* >
^self invalidCall
!
getCurrentProcess
"Answer handle of the Dolphin process.
HANDLE GetCurrentProcess()"
<stdcall: handle GetCurrentProcess>
^self invalidCall
!
getCurrentThread
"Answer the handle of the current thread
DWORD GetCurrentThread()"
<stdcall: handle GetCurrentThread>
^self invalidCall
!
getCurrentThreadId
"Answer thread identifier of the currently executing thread (like Processor activeProcess).
'UserLibrary is the <ExternalLibrary> class to represent the Windows system DLL, User32.DLL.
The default instance of this class provides access to most of the Win32 window management API. New functions may be added as required, but the external function naming convention should be followed.
All functions in this library use the stdcall calling convention.'!
!UserLibrary class methodsFor!
clear
"Private - Clear down cached external function addresses and any default
instances of the receiver from previous runs. etc."
super clear.
self environment at: #NONCLIENTMETRICS ifPresent: [:c | c clear]!
fileName
"Answer the host system file name of the external library which
the receiver represents."
^'USER32'! !
!UserLibrary methodsFor!
adjustWindowRectEx: rect dwStyle: styleFlags bMenu: menuPresent dwExStyle: exStyleFlags
"Calculates the required size of the rectangle of a window with extended style based
on the desired client-rectangle size. The window rectangle can then be passed to the
CreateWindowEx function to create a window whose client area is the desired size.
BOOL AdjustWindowRectEx(
LPRECT lpRect, // pointer to client-rectangle structure
LPCTSTR lpClassName, // address of class name string
HINSTANCE hInstance // handle of application instance
);"
<stdcall: bool UnregisterClassA lpvoid handle>
^self invalidCall!
updateWindow: hWnd
"Repaint the client area of the specified window by sending a wmPaint: directly to
the window if its update region is not empty.
BOOL UpdateWindow(
HWND hWnd // handle of window
);"
<stdcall: bool UpdateWindow handle>
^self invalidCall!
validate: hWnd lpRect: aRECT
"Remove aRECT from hWnd's update region (that portion of the
windows client area that requires repainting).
BOOL ValidateRect(
HWND hWnd, // handle of window with changed update region
CONST RECT *lpRect // address of rectangle coordinates
);"
<stdcall: bool ValidateRect handle RECT* >
^self invalidCall!
vkKeyScan: aChar
"Translate a character to the corresponding virtual-key code
and shift state for the current keyboard.
SHORT VkKeyScan(
TCHAR ch // character to translate
);"
<stdcall: sword VkKeyScanA char>
^self invalidCall
!
windowFromPoint: aPOINTL
"The WindowFromPoint function retrieves the handle of the window that contains the
specified point.
HWND WindowFromPoint(
POINT Point); // structure with point
Return Values:
If the function succeeds, the return value is the handle of the window that contains the
point. If no window exists at the given point, the return value is NULL.
Remarks:
The WindowFromPoint function does not retrieve the handle of a hidden or disabled
window, even if the point is within the window. Use the ChildWindowFromPoint function
for a nonrestrictive search."
<stdcall: handle WindowFromPoint POINTL>
^self invalidCall! !
VMLibrary comment:
'VMLibrary is an <ExternalLibrary> to represent the Dolphin Smalltalk Virtual Machine (VM).
The VM contains, for example, a number of exports to implement pseudo-primitive operations, in particular to simplify the interface to other external library functions, and external call methods to access these exported functions are implemented here.
Instance Variables:
wndProc - <Integer> address of the VM''s window procedure.
dlgProc - <ExternalAddress>. Pointer to the VM''s dialog procedure.
genericCallback - <Integer> address of the VM''s common callback entry point.
vtable - <ExternalAddress>. Pointer to the VM''s common virtual table (for implementing C++/COM objects).
Class Variables:
Registry - <Array> of <Object>s shared between the VM and the image. N.B. It is not possible to modify this object directly, as it is read-only.
RegistryKeys - <LookupTable> mapping symbolic names to the <Integer> indices of objects in the VM registry.
'!
!VMLibrary class methodsFor!
fileName
"Answer the host system file name of the library. This may vary."
^self shouldNotImplement!
initialize
"Private - Initialize the receiver's class variables - see class comment for further details.
VMLibrary initialize
"
"Registry := DO NOT ASSIGN ME."
RegistryKeys := (IdentityDictionary new)
at: #Smalltalk put: 9;
at: #Processor put: 10;
at: #arithmeticSelectors put: 16;
at: #commonSelectors put: 31;
at: #Metaclass put: 81;
at: #Character put: 82;
at: #Array put: 83;
at: #String put: 84;
at: #Symbol put: 85;
at: #SmallInteger put: 86;
at: #Process put: 87;
at: #CompiledMethod put: 88;
at: #MethodContext put: 89;
at: #BlockClosure put: 90;
at: #Message put: 91;
at: #ByteArray put: 92;
at: #UnicodeString put: 93;
at: #CompiledExpression put: 94;
at: #ExternalMethod put: 95;
at: #Float put: 96;
at: #UndefinedObject put: 97;
at: #Association put: 98;
at: #Semaphore put: 99;
at: #ExternalAddress put: 100;
at: #ExternalHandle put: 101;
at: #Dispatcher put: 102;
at: #LPVOID put: 103;
at: #Point put: 104;
at: #PoolConstantsDictionary put: 105;
at: #CompilationResult put: 106;
at: #LargeInteger put: 107;
at: #VARIANT put: 108;
at: #BSTR put: 109;
at: #DATE put: 110;
at: #Corpse put: 111;
at: #InputSemaphore put: 112;
at: #FinalizeSemaphore put: 113;
at: #BereavementSemaphore put: 114;
at: #FinalizeQueue put: 118;
at: #BereavementQueue put: 119;
at: #GUID put: 120;
at: #KernelHandle put: 121;
at: #VMHandle put: 122;
at: #DolphinHandle put: 123;
at: #IUnknown put: 124;
at: #WakeupEvent put: 125;
at: #RtfStyles put: 127;
at: #IDispatch put: 128;
at: #ImageVersionMajor put: 129;
at: #ImageVersionMinor put: 130;
at: #CRTHandle put: 132;
at: #MemoryManager put: 133;
at: #BYTE put: 134;
at: #SBYTE put: 135;
at: #WORD put: 136;
at: #SWORD put: 137;
at: #DWORD put: 138;
at: #SDWORD put: 139;
at: #FLOAT put: 140;
at: #DOUBLE put: 141;
at: #VARIANT_BOOL put: 142;
at: #CURRENCY put: 143;
at: #DECIMAL put: 144;
at: #LPBSTR put: 145;
shrink;
yourself!
open
"Answer the singleton instance of the receiver (it cannot be re-opened)"
^default!
registryKeys
"Private - Answer the map between symbolic names and VM registry indices."
^RegistryKeys! !
!VMLibrary methodsFor!
addressFromInteger: anInteger
"Private - Answer a new ExternalAddress instantiated from the argument.
Implementation Note: AnswerDWORD() is a simple function which returns its 32-bit argument.
By appropriately specifying the argument and return types, we can use external call
primitive's argument coercion and return object instantiation, to perform useful type
conversions very quickly."
<stdcall: lpvoid AnswerDWORD dword>
^self invalidCall!
applicationHandle
"Answer the handle of the Dolphin application instance."
"Private - Answer a String containing the version format used by the receiver."
^'%3!!d!!.%4!!d!!%5!!d!!'! !
_FPIEEE_RECORD comment:
'_FPIEEE_RECORD is an <ExternalStructure> class to represent the Win32 structure of the same name. _FPIEEE_RECORD is used in the reporting of IEEE compliant floating point exceptions.'!
!_FPIEEE_RECORD class methodsFor!
defineFields
"Define the fields of the _FPIEEE_RECORD 'structure'. The _FPIEEE_RECORD is a
rather complex structure containing details of a floating point exception.
"Answer an <integer> which identifies the type of operation being attemped when the exception
occurred. See fpieee.h in the MS Win32 SDK for further information."
^(self flags bitShift: -5) bitAnd: 16rFFF! !
_FPIEEE_VALUE comment:
'_FPIEEE_VALUE is an <ExternalStructure> class to represent the Win32 structure of the same name. _FPIEEE_VALUE is used in the reporting of IEEE compliant floating point exceptions.'!
!_FPIEEE_VALUE class methodsFor!
defineFields
"Define the fields of the _FPIEEE_VALUE 'structure'.
"Answer the receiver's value field as a Smalltalk object."
^(bytes doubleAtOffset: 0)!
value: anObject
"Set the receiver's value field to the value of anObject."
bytes doubleAtOffset: 0 put: anObject! !
ExternalArray comment:
'ExternalArray is a specialized class of <ExternalStructure> to represent contiguous heterogeneous arrays of external types, be they scalar of structured. The various subclasses can be used for external interfacing tasks such as where C arrays are expected.
StructureArray is the most general of the subclasses in that it supports arbitrary element types (represented by other ExternalStructures), and can in fact perform the task of the other subclasses such as DWORDArray. The more specialized subclasses do, however, offer much greater efficiency where they are applicable.
Specialized subclasses are provided for most standard intrinsic types; signed and unsigned integers of 16 and 32-bits, single and double precision floating point numbers, etc. Note that there is no subclass for arrays of bytes, since the standard ByteArray class already fulfills that requirement.
Instance Variables:
length <integer>. Number of elements in the instance.
'!
!ExternalArray class methodsFor!
alignment
"Answer the alignment required for instances of the receiver when
embedded in arrays or other structures. This is the alignment of the
largest field in the receiver."
^self elementSize!
elementSize
"Private - Answer the size of the receiver's instances' constituent
elements in bytes."
^1!
fromAddress: anAddress length: anInteger
"Answer a new instance of the receiver that points at an
array of anInteger elements of type elementClass at anAddress.
Implementation Note: If the length is zero, then we ignore the address (even if invalid).
If the length is non-zero then we answer nil if the address is the Null pointer."
^anInteger == 0
ifTrue: [self basicNew basicLength: 0]
ifFalse: [
anAddress isNull ifFalse: [
self basicNew
initializeAtAddress: anAddress;
basicLength: anInteger]]!
icon
"Answers an Icon that can be used to represent this class"
^Array icon!
length: count elementSize: bytes
"Private - Answer a new instance of the receiver allocated
with space for count elements of bytes size."
^(super new: count*bytes)
basicLength: count!
new: anInteger
"Answer a new instance of the receiver allocated at an immovable location."
"Answer the class of object to be used when copying the receiver."
^Array! !
ExternalInteger comment:
'ExternalInteger is an abstract class of ExternalStructures to represent machine native integer formats. Various subclasses are defined to represent the signed and unsigned forms with varying numbers of bits:
8-bit
signed SBYTE
unsigned BYTE
16-bit
signed SWORD
unsigned WORD
32-bit
signed SDWORD
unsigned DWORD
64-bit
signed LARGE_INTEGER
unsigned ULARGE_INTEGER
'!
!ExternalInteger class methodsFor!
decompileDefinition
"Don't allow the receiver and its subclasses to be decompiled since they are
required by fundamental aspects of the system such as streaming"
!
defineTemplate
"Initialize the receiver class' structure template."
super defineTemplate.
alignment := self elementSize!
fromInteger: anInteger
"Answer a new instance of the receiver with contents copied from anInteger"
^self new value: anInteger!
icon
"Answer a suitable iconic representation for the receiver."
^Integer icon!
newAspect: aspectClass name: aSymbol
"Private - Answer a new <Aspect> of the class, aspectClass, and with name, aSymbol,
which is appropriate for representing aspects of the receiver's type."
"Answer the receiver's value field as a Smalltalk object."
^(bytes floatAtOffset: 0)!
value: anObject
"Set the receiver's value field to the value of anObject."
bytes floatAtOffset: 0 put: anObject! !
LPVOID comment:
'LPVOID is an <ExternalStructure> class useful for representing pointers to arbitrary external memory blocks. In most respects LPVOID behaves like <ExternalAddress>, except that instances may be allocated using #newBuffer which can be passed to #lpvoid arguments without the VM implicitly dereferencing the address (i.e. the behaviour will be the same as if an ExternalAddress had been passed to an lppvoid parameter). LPVOID is also a pointer object, and can thus add instance variables to hold additional state.
LPVOID is useful, for example, where references to pointers (i.e. VOID**) are required, an example being COM [out] pointer parameters. The VM also passes instances of LPVOID as lpvoid input parameters to callbacks and COM method implementations.
It is important to realise that LPVOID (and subclasses) are unlike other ExternalStructures in that they are already pointers, and therefore they already incorporate one level of indirection. Thus:
1) #value answers the pointed at address in the case of doubly-indirect (reference) instances, or the address itself for internal buffer instances.
2) The class method #fromAddress: will answer a pointer to a pointer, i.e. a double-indirection. This means that, for example, the subclass LPWSTR is useful as an element class for a <StructureArray> of LPWSTR pointers (as expected), but that ''LPWSTR fromAdddress: aUnicodeString yourAddress'' is not valid.'!
!LPVOID class methodsFor!
defineFields
"Define the fields of the LPVOID 'structure'.
LPVOID compileDefinition
"
self defineField: #value type: LPVOIDField new!
new
"Answer a new instance of the receiver.
Implementation Note: LPVOID and its subclasses represent pointers, and are typically
used for double indirections, thus a reference is normally required."
"Answer the address contained in or referenced by the receiver."
^self value!
value
"Answer the receiver's value field as a Smalltalk object."
^(bytes dwordAtOffset: 0) asExternalAddress!
value: anObject
"Set the receiver's value field to the value of anObject."
bytes dwordAtOffset: 0 put: anObject! !
MINMAXINFO comment:
'<MINMAXINFO> is an <ExternalStructure> class to wrap the struct ''Win.MINMAXINFO'' from type information in the ''Windows API (ANSI)'' library.
The type library contains no documentation for this struct
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.
"Answer the receiver's ptMaxTrackSize field as a Smalltalk object."
^POINTL fromAddress: (bytes yourAddress + 32)!
ptMaxTrackSize: anObject
"Set the receiver's ptMaxTrackSize field to the value of anObject."
anObject replaceBytesOf: bytes from: 33 to: 40 startingAt: 1!
ptMinTrackSize
"Answer the receiver's ptMinTrackSize field as a Smalltalk object."
^POINTL fromAddress: (bytes yourAddress + 24)!
ptMinTrackSize: anObject
"Set the receiver's ptMinTrackSize field to the value of anObject."
anObject replaceBytesOf: bytes from: 25 to: 32 startingAt: 1! !
OLEStructure comment:
'OLEStructure is an <ExternalStructure> the primary purpose of which is to group all OLE/COM related structure classes. OLEStructure also provides the basic boilerplate initialization needed for structures which have a ''sizeof'' member at offset 0 (see LICINFO for an example).'!
!OLEStructure methodsFor!
dwSize: anInteger
"Store the size of the structure into itself (a common feature of Win32 structures,
but unfortunately not all, so the default is to do nothing)"!
initialize: anInteger
"Private - Initialize the state of the receiver."
super initialize: anInteger.
self dwSize: anInteger! !
POINTF comment:
'<POINTF> is an <ExternalStructure> class to wrap the struct of the same name.
POINTF is a cartesian coordinate with single precision floating point x and y values.'!
!POINTF class methodsFor!
defineFields
"Define the fields of the POINTF structure.
POINTF compileDefinition
typedef struct tagPOINTF {
single x;
single y;
} POINTF;
"
self
defineField: #x type: FLOATField new offset: 0;
defineField: #y type: FLOATField new offset: 4.
self byteSize: 8! !
!POINTF methodsFor!
x
"Answer the receiver's x field as a Smalltalk object."
^(bytes floatAtOffset: 0)!
x: anObject
"Set the receiver's x field to the value of anObject."
bytes floatAtOffset: 0 put: anObject!
y
"Answer the receiver's y field as a Smalltalk object."
^(bytes floatAtOffset: 4)!
y: anObject
"Set the receiver's y field to the value of anObject."
bytes floatAtOffset: 4 put: anObject! !
StructurePointer comment:
''!
!StructurePointer class methodsFor!
byteSize
^4!
elementClass: elementClass
"Answer a new instance of the receiver that will contain a pointer to
an <ExternalStructure> or the specified type."
^self new
elementClass: elementClass;
yourself!
fromAddress: anAddress elementClass: elementClass
"Answer a new instance of the receiver that contains a pointer to
an <ExternalStructure> of the specified type."
^anAddress isNull ifFalse: [
self basicNew
initializeAtAddress: anAddress;
elementClass: elementClass;
yourself]!
newNull: pointerClass elementClass: elementClass
"Answer a new instance of the receiver that contains an
initially null memory pointer of the specified class pointer to
an <ExternalStructure> of the specified type."
^self basicNew
initializeAtAddress: pointerClass new;
elementClass: elementClass;
yourself! !
!StructurePointer methodsFor!
elementClass
"Private - Answer the value of the receiver's ''elementClass'' instance variable."
^elementClass!
elementClass: anObject
"Private - Set the value of the receiver's ''elementClass'' instance variable to the argument, anObject."
elementClass := anObject!
printOn: aStream
"Print a string representation of self on aStream."
aStream
basicPrint: self;
nextPut: $(.
self isNull
ifTrue: [aStream nextPutAll: 'NULL']
ifFalse: [aStream print: self value].
aStream nextPut: $).!
value
"Answer the receiver's value field as a Smalltalk object."
^self elementClass fromAddress: bytes! !
VOID comment:
'VOID is an <ExternalStructure> class to represent unspecified, null, or opaque types.
VOID is only useful in pointer form, and mainly intended to provided a unified type scheme for auto-generation of structures from type libraries.'!
'Win32Structure is the abstract superclass of all classes that describe <ExternalStructure>s that are a part of the Win32 API. For the most part, these structures hold a <DWORD> byte size as the first field which Windows can use as version information to determine how the structure is to be interpreted. Where available, this is set using #dwSize:.
'!
!Win32Structure methodsFor!
dwSize: anInteger
"Store the size of the structure into itself (a common feature of Win32 structures,
but unfortunately not all, so the default is to do nothing)"!
initialize: anInteger
"Private - Initialize the state of the receiver."
super initialize: anInteger.
self dwSize: anInteger! !
IUnknown comment:
'<IUnknown> is a wrapper class for the COM interface ''stdole.IUnknown'' originally generated from type information in the ''OLE Automation'' library. It contains methods to invoke the member functions exposed by that interface.
IUnknown is the fundamental interface supported by all COM objects and is therefore ubiquitous for any component regardless of implementation. IUnknown includes behaviour to control object lifetime by reference counting, and for interface negotiation using QueryInterface.
Note that most of Dolphin''s supporting behaviour wrapping IUnknown is implemented in the superclass in order not to overwhelm the fundamental simplicity of IUnknown.'!
!IUnknown class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'stdole.IUnknown'
Implementation Note: These functions are the core of COM and are crucial to good performance,
therefore they are implemented as special classes of function which don't need to use the
"Invoke the QueryInterface() method of the object wrapped by the receiver.
HRESULT __stdcall QueryInterface(
[in] GUID* riid,
[out] void** ppvObject);
Implementation Note: Return integer hresult value rather than have exception thrown, as
E_NOINTERFACE is not really an exceptional condition at all."
<virtual stdcall: sdword 1 GUID* void**>
^self invalidCall!
Release
"Invoke the Release() method of the COM object wrapped by the receiver.
unsigned long __stdcall Release();
"
<virtual stdcall: dword 3>
^self invalidCall
! !
IAxWinHostWindow comment:
'<IAxWinHostWindow> is a wrapper class for the COM interface ''DolphinVMLib.IAxWinHostWindow'' generated from type information in the ''Dolphin Smalltalk'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains the following helpstring for this interface
"IAxWinHostWindow Interface"
This interface is very similar to ATL defined interface of the same name, with the slight difference that the CreateControlEx() method takes an additional parameter which allows one to specify a license key for instantiating licensed controls. The IID is also different of course.'!
'<ICatInformation> is a wrapper class for the COM interface ''COMCAT.ICatInformation'' generated from type information in the ''OLE Component Categories Library'' library. It contains methods to invoke the member functions exposed by that interface.
ICatInformation provides methods for obtaining information about the categories implemented or required by a certain class, as well as information about the categories registered on a given machine.
See MSDN for further information about COM Component Categories.
Class Variables:
CatMan <ICatInformation>. Singleton instance.
Controls <Array>. Cached <COMObjectRegistration>s for all controls registered on the machine.
'<ICatRegister> is a wrapper class for the COM interface ''COMCAT.ICatRegister'' generated from type information in the ''OLE Component Categories Library'' library. It contains methods to invoke the member functions exposed by that interface.
ICatRegister provides methods for registering and unregistering component category information in the Registry. This includes both the human-readable names of categories and the categories implemented/required by a given component or class.
'<IClassFactory> is a wrapper class for the custom interface ''UNKNWN.IClassFactory'' from type information in the ''IUnknown Type Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!IClassFactory class methodsFor!
ctxAll
"Answer the flags to be used to specify instance creation from any source.
N.B. This varies depending on whether the operating system supports remote
servers, and so is not strictly a constant (thanks guys)."
^self ctxServer | CLSCTX_INPROC_HANDLER!
ctxServer
"Answer the flags to be used to specify instance creation from any type of server.
N.B. This varies depending on whether the operating system supports remote
servers, and so is not strictly a constant (thanks guys)."
"Invoke the LockServer() method of the object wrapped by the receiver.
HRESULT __stdcall LockServer(
[in] long fLock);
"
<virtual stdcall: hresult 5 sdword>
^self invalidCall! !
IConnectionPoint comment:
'<IConnectionPoint> is a wrapper class for the custom interface ''OBJIDL.IConnectionPoint'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
'<IConnectionPointContainer> is a wrapper class for the custom interface ''OBJIDL.IConnectionPointContainer'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
'<ICreateErrorInfo> is a wrapper class for the custom interface ''OAIDL.ICreateErrorInfo'' from type information in the ''Ole Automation Type Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.'!
!ICreateErrorInfo class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'OAIDL.ICreateErrorInfo'
ICreateErrorInfo defineTemplate
"
self
defineFunction: #SetGuid:
argumentTypes: 'GUID*';
defineFunction: #SetSource:
argumentTypes: 'lpwstr';
defineFunction: #SetDescription:
argumentTypes: 'lpwstr';
defineFunction: #SetHelpFile:
argumentTypes: 'lpwstr';
defineFunction: #SetHelpContext:
argumentTypes: 'dword'
!
fromEXCEPINFO: excepInfo guid: id
"Answer a new instance of the receiver on a system extended error object
with details from the <EXCEPINFO> structure, excepInfo."
| answer |
answer := self new.
id notNull ifTrue: [answer SetGuid: id].
^answer
SetSource: excepInfo wstrSource;
SetDescription: excepInfo wstrDescription;
SetHelpContext: excepInfo dwHelpContext;
SetHelpFile: excepInfo wstrHelpFile;
yourself!
new
"Answer a new instance of the receiver on a new error info. object (implemented by the system)"
| answer |
answer := self newPointer.
OLEAutLibrary default createErrorInfo: answer.
^answer! !
!ICreateErrorInfo methodsFor!
errorInfo
"Answer an IErrorInfo on the receiver's object."
^self queryInterface: IErrorInfo!
SetDescription: szDescription
"Invoke the SetDescription() method of the object wrapped by the receiver.
HRESULT __stdcall SetDescription(
[in] LPWSTR szDescription);
"
<virtual stdcall: hresult 6 lpwstr>
^self invalidCall
!
SetGuid: rguid
"Invoke the SetGuid() method of the object wrapped by the receiver.
HRESULT __stdcall SetGuid(
[in] GUID* rguid);
"
<virtual stdcall: hresult 4 GUID*>
^self invalidCall
!
SetHelpContext: dwHelpContext
"Invoke the SetHelpContext() method of the object wrapped by the receiver.
HRESULT __stdcall SetHelpContext(
[in] unsigned long dwHelpContext);
"
<virtual stdcall: hresult 8 dword>
^self invalidCall
!
SetHelpFile: szHelpFile
"Invoke the SetHelpFile() method of the object wrapped by the receiver.
HRESULT __stdcall SetHelpFile(
[in] LPWSTR szHelpFile);
"
<virtual stdcall: hresult 7 lpwstr>
^self invalidCall
!
SetSource: szSource
"Invoke the SetSource() method of the object wrapped by the receiver.
HRESULT __stdcall SetSource(
[in] LPWSTR szSource);
"
<virtual stdcall: hresult 5 lpwstr>
^self invalidCall
! !
IDispatch comment:
'<IDispatch> is a wrapper class for the standard AX automation dynamic dispatch interface of the same name. It was generated from type information in the ''OLE Automation'' library, stdole2.tlb. It contains methods to invoke the member functions exposed by that interface.'!
= ╨╩±▓⌠zìN Uê─C²α≥ªù`0[a═░z; ┤ê∞+6╗, N s ╩Γδ/F¬Γ/(ß┼és▄O┬⌠û0▒1+oIJ;±Ußâ!!ΦìIçÖ;rOQ£┼îmΦN·╔─╛ÄD┴Θ±c÷ûêr≈5╤╦²Ω∩*╖Äù≡è ╥~«╛╟εF┬╨[ΦHO0φDI,▄[ª5w┬s╛c)p╟åå"@ⁿ⌠ε!
"Advance the receiver's position in the stream by anInteger elements.
Answer whether the request was successful (e.g. an attempt to advance beyond the
end of the enumeration will answer false).
Implementation Note: Only advancement is possible (Skip() takes an unsigned argument.
In order to perform negative skips we would have to reset the current position and
reset, then skip forward as appropriate).
This is not 100% compatible with PositionableStream>>skip: as it cannot skip backwards
and does not handle attempts to skip beyond the end of the stream in the same way."
^(self Skip: anInteger) == S_OK!
Skip: skip
"Private - Invoke the IEnumXXXX::Skip() interface function."
<virtual stdcall: hresult 5 dword>
^self invalidCall!
upToEnd
"Answer a collection consisting of the remaining elements in the receiver (i.e. from the current
position to the end)."
| elements elem |
elements := OrderedCollection new.
self upToEndDo: [:e | elements addLast: e].
^elements
!
upToEndDo: operation
"Private - Evaluate the <monadicValuable> argument, transformer, for
each of the remaining elements of the receiver.
Implementation Note: To reduce round trips to the server object, the elements
are fetched in blocks of <N> at a time, where N is configurable. Note that we
stop enumerating when the object returns fewer elements than we ask for, since
it seems that some objects have a bug whereby they will restart the enumerator
after having read off the end. See #batchSize for further information."
| count |
count := self batchSize.
[| elems |
elems := self nextAvailable: count.
elems do: [:e | operation value: e].
elems size < count]
whileFalse! !
IErrorInfo comment:
'<IErrorInfo> is a wrapper class for the standard OLE Automation interface IErrorInfo.
IErrorInfo is the interface used to make available extended error information to a client when an exception occurs and an HRESULT failure code is returned.'!
!IErrorInfo class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'OAIDL.IErrorInfo'
IErrorInfo defineTemplate
"
self
defineFunction: #GetGUID:
argumentTypes: 'GUID*';
defineFunction: #GetSource:
argumentTypes: 'bstr*';
defineFunction: #GetDescription:
argumentTypes: 'bstr*';
defineFunction: #GetHelpFile:
argumentTypes: 'bstr*';
defineFunction: #GetHelpContext:
argumentTypes: 'dword*'
!
fromEXCEPINFO: excepInfo guid: id
"Answer a new instance of the receiver on a system extended error object
with details from the <EXCEPINFO> structure, excepInfo."
"Answer an <EXCEPINFO> containing most of the details from the receiver
(with the exception of the guid)."
| ex bstr |
ex := EXCEPINFO new.
ex scode: E_FAIL. "No other hresult available, caller might be able to substitute something more specific"
bstr := BSTR new.
self GetSource: bstr.
ex bstrSource: bstr detach.
self GetDescription: bstr.
ex bstrDescription: bstr detach.
self GetHelpFile: bstr.
ex bstrHelpFile: bstr detach.
ex dwHelpContext: self helpContext.
^ex!
GetDescription: pBstrDescription
"Invoke the GetDescription() method of the object wrapped by the receiver.
HRESULT __stdcall GetDescription(
[out] BSTR* pBstrDescription);
"
<virtual stdcall: hresult 6 bstr*>
^self invalidCall
!
GetGUID: pGUID
"Invoke the GetGUID() method of the object wrapped by the receiver.
HRESULT __stdcall GetGUID(
[out] GUID* pGUID);
"
<virtual stdcall: hresult 4 GUID*>
^self invalidCall
!
GetHelpContext: pdwHelpContext
"Invoke the GetHelpContext() method of the object wrapped by the receiver.
HRESULT __stdcall GetHelpContext(
[out] unsigned long* pdwHelpContext);
"
<virtual stdcall: hresult 8 dword*>
^self invalidCall
!
GetHelpFile: pBstrHelpFile
"Invoke the GetHelpFile() method of the object wrapped by the receiver.
HRESULT __stdcall GetHelpFile(
[out] BSTR* pBstrHelpFile);
"
<virtual stdcall: hresult 7 bstr*>
^self invalidCall
!
GetSource: pBstrSource
"Invoke the GetSource() method of the object wrapped by the receiver.
HRESULT __stdcall GetSource(
[out] BSTR* pBstrSource);
"
<virtual stdcall: hresult 5 bstr*>
^self invalidCall
!
helpContext
"Answer the <integer> help context associated with the receiver."
| answer |
answer := DWORD new.
self GetHelpContext: answer.
^answer!
helpFile
"Answer the path of the error file associated with the receiver
(used in conjunction with the error context)."
| answer |
answer := BSTR new.
self GetHelpFile: answer.
^answer asString!
printOn: aStream
"Append a developer friendly textual representation of the receiver to aStream.
As OLE interfaces are opaque, pure, interfaces, we revert to the basic
implementation, but include the address as this may help."
self isNull ifTrue: [^super printOn: aStream].
aStream
basicPrint: self;
nextPut: $(;
print: self source;
nextPutAll: ': ';
print: self description;
nextPut: $)!
source
"Answer the error description from the receiver."
| answer |
answer := BSTR new.
self GetSource: answer.
^answer asString!
sourceInterface
"Answer the IID of the interface which raised the error."
| answer |
answer := IID new.
self GetGUID: answer.
^answer! !
IFont comment:
'<IFont> is a wrapper class for the COM interface ''OCIDL.IFont'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
'ILockBytes is a COMInterface class to wrap the standard COM interface of the same name.
ILockBytes is an abstraction of a simple byte-oriented block-mode device for reading, writing and locking (though this is typically not implemented) blocks of storage. Typically we will be using an ILockBytes on a device implemented externally to Dolphin, but see the OLELockBytes class for an example of an ILockBytes implemented in Dolphin over a ByteArray. ILockBytes is the "device" interface underlying OLEs Structured Storage mechanism. The relationship between IStorage/IStreams and ILockBytes is somewhat similar to that between PositionableStreams and SequenceableCollections.
We are mainly interested in ILockBytes in order to test out our own implementations of it easily from within Smalltalk. It is an unusual occurrence that one would actually need to call ILockBytes methods oneself.
Example:
"Open an ILockBytes on a global memory block"
i := ILockBytes onHGLOBAL.
i replaceFrom: 1 to: 5 with: #[72 101 108 108 111] startingAt: 1.
'<IMalloc> is a wrapper class for the custom interface ''OBJIDL.IMalloc'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!IMalloc class methodsFor!
clear
"Private - Clear down the standard task/shared allocators (e.g. on startup)."
Task := Shared := nil!
default
"Answer the default IMalloc (task allocator)."
^self task!
defineFunctions
"Declare the virtual function table for the COM interface 'OBJIDL.IMalloc'
IMalloc defineTemplate
"
self
defineFunction: #Alloc:
returnType: 'void*'
argumentTypes: 'dword';
defineFunction: #Realloc:cb:
returnType: 'void*'
argumentTypes: 'void* dword';
defineFunction: #Free:
returnType: 'void'
argumentTypes: 'void*';
defineFunction: #GetSize:
returnType: 'dword'
argumentTypes: 'void*';
defineFunction: #DidAlloc:
returnType: 'sdword'
argumentTypes: 'void*';
defineFunction: #HeapMinimize
returnType: 'void'
!
free
"Private - Free the standard task/shared allocators."
self freeTask.
self freeShared!
freeShared
"Private - Release the default IMalloc (task allocator)."
Shared isNil ifFalse: [
Shared free.
Shared := nil]
!
freeTask
"Private - Release the default IMalloc (task allocator)."
Task isNil ifFalse: [
Task free.
Task := nil]
!
task
"Answer the IMalloc task allocator.
N.B. The task allocator must always be used to allocate [Out] and [In/Out]
parameters."
| pMalloc|
Task isNull ifTrue: [
pMalloc := self newPointer.
OLELibrary default "may throw HRESULTError"
coGetMalloc: MEMCTX_TASK ppMalloc: pMalloc.
Task := pMalloc].
^Task!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
self clear! !
!IMalloc methodsFor!
Alloc: cb
"Invoke the Alloc() method of the object wrapped by the receiver.
void* __stdcall Alloc(
[in] unsigned long cb);
"
<virtual stdcall: void* 4 dword>
^self invalidCall
!
DidAlloc: pv
"Invoke the DidAlloc() method of the object wrapped by the receiver.
int __stdcall DidAlloc(
void* pv);
"
<virtual stdcall: sdword 8 void*>
^self invalidCall
!
Free: pv
"Invoke the Free() method of the object wrapped by the receiver.
void __stdcall Free(
[in] void* pv);
"
<virtual stdcall: void 6 void*>
^self invalidCall
!
GetSize: pv
"Invoke the GetSize() method of the object wrapped by the receiver.
unsigned long __stdcall GetSize(
[in] void* pv);
"
<virtual stdcall: dword 7 void*>
^self invalidCall
!
HeapMinimize
"Invoke the HeapMinimize() method of the object wrapped by the receiver.
void __stdcall HeapMinimize();
"
<virtual stdcall: void 9>
^self invalidCall
!
Realloc: pv cb: cb
"Invoke the Realloc() method of the object wrapped by the receiver.
void* __stdcall Realloc(
[in] void* pv,
[in] unsigned long cb);
"
<virtual stdcall: void* 5 void* dword>
^self invalidCall
! !
IOleClientSite comment:
'<IOleClientSite> is a wrapper class for the COM interface ''OCIDL.IOleClientSite'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
This interface is implemented by Dolphin for call-in only at present (at least until Dolphin supports control creation as well as hosting), so only the function table is needed, hence the absence of any methods.'!
'<IOleObject> is a wrapper class for the COM interface ''OLEIDL.IOleObject'' generated from type information in the ''OLEIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
This class was originally generated by the type library analyzer in Dolphin 4, but many of the OLE interfaces it references are not present in 3.x. The missing interfaces have been replaced with IUnknown, as we are only using a small part of this interface and don''t want to bloat the image with the entirety of OLE Embedding and In-place Activation!!
'<IPerPropertyBrowsing> is a wrapper class for the COM interface ''OCIDL.IPerPropertyBrowsing'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'<IPersist> is a wrapper class for the custom interface ''OBJIDL.IPersist'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
IPersist is at the root of the COM persistance interface hierarchy. The single behaviour provided is an accessor to get the CLSID of the implementing object. Subclasses add the ability to persist to/from ole streams (IPersistStream[Init]), structured storages (IPersistStorage), property bags (IPersistPropertyBag[2]), files (IPersistFile), or a fixed size memory block (IPersistMemory). All of these subinterfaces have some form or Save and Load methods for pickling and reconstituting the implementing COM object.'!
'<IPicture> is a wrapper class for the COM interface ''stdole.IPicture'' generated from type information in the ''OLE Automation'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains the following helpstring for this interface
"Picture Object"
This class was originally auto-generated by the Active-X Component Wizard, but is has been modified to support compatibility between OLE Pictures and other Image types in Dolphin.'!
÷M#=U╬µp┤║¢/ù⌡▄Ωîó─█┬▒αí⌐║╠nvY╘─*ZÆ g_GcH╢æ Vv#]╖eeñδ4≥█¡┤▓ùß╩P╒4m ╞ⁿl<╜▐┼Kë{∙táPíxéAª A ┼S░∞}▄Lq╗Ir╛°¬σ╔¼u╚
ÜżK¬σ_ ΓahòΩ!!É▓5Ä.┬L═ßm`ΩΦz╚Gm╘R█! !
IPropertyNotifySink comment:
'<IPropertyNotifySink> is a wrapper class for the COM interface ''OCIDL.IPropertyNotifySink'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
IPropertyNotifySink is a connection point (event) interface implemented on a container to receiver notifications from a COM object when its properties are either changed, or about to be changed. The particular property in question is identified by <integer> DISPID.
As Dolphin is currently only an OCX container (as opposed to an OCX implementor) this interface is only every used for call-in, and therefore only the function table is needed.'!
'<IProvideClassInfo> is a wrapper class for the COM interface ''OCIDL.IProvideClassInfo'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
IProvideClassInfo contains a single method, #getClassInfo, to enquire the type information (ITypeInfo) for the coclass of the COM object.'!
'<IRecordInfo> is a wrapper class for the COM interface ''OLEIDL.IRecordInfo'' generated from type information in the ''OLEIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'IRootStorage is a COMInterface class to wrap the standard COM interface of the same name.
IRootStorageáis for saving a users data in low-memory situations. Its single method is used to switch a storage object to a different underlying file and to save the storage object to that file, which it guarantees to do, even in low-memory conditions.'!
'ISequentialStream is a COMInterface class to wrap the standard COM interface of the same name.
ISequentialStream is an abstraction of a simple byte-oriented stream for reading, writing blocks of bytes, with the notion of a current position, although ISequentialStream itself defines no functions to access that position. ISequentialStream is somewhat similar to, though more limited than, <ReadWriteStream> and therefore we implement some of the protocol of that class here on top of the raw ISequentialStream member functions.
ISequentialStream is rather abstract, and starts to get more interesting in the subclass, IStream.'!
ΓAhòΩ!!₧╦WΓ.╧K╧ mo∞╩z╟P.╧9±▐ÜPqáε∩∞Θ╝±n√ì╪gh Z t;Ü µpm":á ▀₧╡\c|ÜÑñh&┤Θ┼╜∩!!Ω┐ûâ≈T▄≡╠╔E ╣&╝aYΣ┤{ÇnY╢FƒÅ║Ç╦M£╙╫ªR≈¿b⌡'└ΘóƒT`[L3┐Z∙₧râ=ïZ┌Cp»ntêⁿ0±gO! !
IServiceProvider comment:
'<IServiceProvider> is a wrapper class for the COM interface ''OCIDL.IServiceProvider'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!IServiceProvider class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'OCIDL.IServiceProvider'
IServiceProvider defineTemplate
"
self
defineFunction: #QueryService:riid:ppvObject:
argumentTypes: 'GUID* GUID* IUnknown**'
! !
!IServiceProvider methodsFor!
queryService: guidService riid: riid
"Query the 'service' identified by the <GUID>, guidService, answering an
interface pointer of appropriate class for the <IID>, riid, on an object
'IStorage is a COMInterface class to wrap the standard COM interface of the same name.
IStorage is an abstraction to represent a structured storage mechanism somewhat similar to a file system which contains both streams (files), represented by IStream interfaces, and sub-storages (sub-directories), represented by further IStorage interfaces. The standard system implementation of IStorage provides a file system within a file (or in fact, and byte device which implements ILockBytes). These are commonly called "compound files".
A notable use of Structure Storage is Word documents.
We do not actually implement this interface in Dolphin, only use it as a means of accessing the system provided structure storage mechanism.
Note that the system compound file implementation can be transaction, unless storages are opened in transacted mode (i.e. STGM_DIRECT). Transacted storages support committing and rolling back changes. The default on freeing (i.e. calling Release()) on a storage is to rollback transacted changes to the last commit point,
so it is wise to explicitly commit changes using #flush, or by sending #close.
'<ISupportErrorInfo> is a wrapper class for the custom interface ''OAIDL.ISupportErrorInfo'' from type information in the ''Ole Automation Type Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!ISupportErrorInfo class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'OAIDL.ISupportErrorInfo'
ISupportErrorInfo defineTemplate
"
self
defineFunction: #InterfaceSupportsErrorInfo:
argumentTypes: 'GUID*'
! !
!ISupportErrorInfo methodsFor!
InterfaceSupportsErrorInfo: riid
"Invoke the InterfaceSupportsErrorInfo() method of the object wrapped by the receiver.
HRESULT __stdcall InterfaceSupportsErrorInfo(
[in] GUID* riid);
"
<virtual stdcall: hresult 4 GUID*>
^self invalidCall
!
supportsErrorInfo: interface
"Answer whether error information is supported for the specified interface
'ITypeInfo is a COMInterface class which wraps an OLE Automation ITypeInfo interface pointer.
ITypeInfo contains member functions which allow one to enquire about the structure and attributes of individual elements of a Type Library. Unfortunately it is rather poorly factored (much in need of conditional elimination in fact) in that an ITypeInfo can describe any one of the following automation elements:
- an enum that is, an enumerated type.
- a struct (that is, a structure definition)
- a module (?)
- an interface (that is, an IUnknown derived custom interface)
- a dispinterface (that is, an IDispatch derived Automation interface)
- a coclass (that is, an instantiable component class with a CLSID)
- a typedef (that is, a C style typedef which defines a name for a type)
- a union (that is, a structure definition with variant fields)
These types correspond to the members of the TYPEKIND enumeration, respectively:
- TYPEKIND_ENUM
- TYPEKIND_RECORD
- TYPEKIND_MODULE
- TYPEKIND_INTERFACE
- TYPEKIND_DISPATCH
- TYPEKIND_COCLASS
- TYPEKIND_ALIAS
- TYPEKIND_UNION
As an ITypeInfo can describe any of these quite disparate types, it contains a union of all the necessary methods to access all the possible information for each possible type. This makes it rather a large and complex interface, and also means that a number of the methods may not be relevant any individual ITypeInfo instance - one has to do a switch on type(kind) to determine which are relevant. With this in mind we have chosen to provide a separate hierarchy of classes to wrap ITypeInfo - see AXTypeInfoAnalyzer and subclasses.'!
╞A3.,(í¼=$¬≤╠:ò ┬█Γ▄ô╜╢ùÄα¼EB½╛Ç63aX─ï5W╫KL/.|V;∩æzi+_δ5gº┐(⌡┌«≈úû≥Å?1║4Qde┘¿-%╝╚╨IMæVæ5║K│=é TF =≤*≥┤4÷+ ä2αº∩┬îƒL¢¢ÿÆpε╓RPûy~íα>╬ù2ì(FÑd╒τ!!╨≤a╥GM╧2íû╔dúÜ█±φß»6╨ó▀`o/ o Ü Γpb[T╩┴ ╨ßQ9PY╓òo▐+óΘ┴╜▀nΘ¬╦ç─S▀è≈╩ 1K¬}≡p|π╜e¡!
'ITypeLib is a <COMInterface> class which wraps an COM Automation ITypeLib interface pointer.
The purpose of ITypeLib is to serve as the top-level entry point to a COM type library, which is a repository of meta-information about COM objects and interfaces. An ITypeLib is typically acquired either by loading a type library explicitly from the resources of a COM server or a .TLB file, or directly from a COM object via an interface such as IProvideClassInfo.
The member functions of ITypeLib permit one to enquire about general attributes of the library, but more importantly they enable one to enumerate through the individual meta-elements by acquiring ITypeInfo interfaces on them.
ITypeLib is a complex and very powerful interface so we have chosen to separate most of Dolphin''s higher level wrapping into a separate class, namely AXTypeLibraryAnalyzer. Therefore the only methods implemented here are the virtual call outs and a few simple wrappers for those.
ITypeLib is primarily of use in the construction of programming tools (it is fundamental to Dolphin''s support for auto-generation of COM object wrappers), but it is unlikely to be of much relevance to most applications.'!
'<IClassFactory2> is a wrapper class for the custom interface ''OCIDL.IClassFactory2'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!IClassFactory2 class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'OCIDL.IClassFactory2'
"Invoke the GetLicInfo() method of the object wrapped by the receiver.
HRESULT __stdcall GetLicInfo(
[out] LICINFO* pLicInfo);
"
<virtual stdcall: hresult 6 LICINFO*>
^self invalidCall
!
requestLicenseKey
"Request a runtime license key"
| license |
license := BSTR new.
self RequestLicKey: 0 pBstrKey: license.
^license!
RequestLicKey: dwReserved pBstrKey: pBstrKey
"Invoke the RequestLicKey() method of the object wrapped by the receiver.
HRESULT __stdcall RequestLicKey(
[in] unsigned long dwReserved,
[out] BSTR* pBstrKey);
"
<virtual stdcall: hresult 7 dword bstr*>
^self invalidCall
! !
IAxWinAmbientDispatch comment:
'<IAxWinAmbientDispatch> is a wrapper class for the COM interface ''ATLLib.IAxWinAmbientDispatch'' generated from type information in the ''ATL 2.0 Type Library'' library.
The purpose of this dual interface is to substitute for the IDispath interface required of an OLE client site that implements ambient properties. In conjunction with a type library this dual interface provides a simple and efficient implementation of the standard dispinterface for ambient properties.'!
'<IFontDisp> is a wrapper class generated for the dispatch interface ''stdole.Font'' from type information in the ''OLE Automation'' library (stdole2.tlb). It contains methods to get and set the properties exposed by that interface.
IFontDisp is a standard dispinterface used to represent OLE Fonts, for example to get/set the font ambient property of an ActiveX control site.'!
'IMSControl is an abstract superclass the purpose of which is to share the common implementation details for typical MS OCXs designed primarily for use in VB. These controls have a number of common properties.'!
'<Picture> is a wrapper class generated for the dispatch interface ''stdole.Picture'' from type information in the ''OLE Automation'' library. It contains methods to get and set the properties and invoke the methods exposed by that interface.
The type library contains no documentation for this dispinterface
Warning: This comment was automatically generated from the dispinterface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'<IRandomStream> is a wrapper class for the COM interface ''RANDOMLib.IRandomStream'' generated from type information in the ''Random 1.0 Type Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains the following helpstring for this interface:
"IRandomStream Interface"
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!IRandomStream class methodsFor!
clsid
"Private - Answer the CLSID of the coclass (RandomStream) for which the receiver is the default interface.
"Declare the virtual function table for the COM interface 'RANDOMLib.IRandomStream'
IRandomStream defineTemplate
"
self
defineFunction: #Next:
argumentTypes: 'sdword*';
defineFunction: #get_Seed:
argumentTypes: 'sdword*';
defineFunction: #put_Seed:
argumentTypes: 'sdword';
defineFunction: #get_LowerBound:
argumentTypes: 'sdword*';
defineFunction: #put_LowerBound:
argumentTypes: 'sdword';
defineFunction: #get_UpperBound:
argumentTypes: 'sdword*';
defineFunction: #put_UpperBound:
argumentTypes: 'sdword'
!
initializeTypeLib
"Private - Establish a connection to the receiver's type library.
IRandomStream initializeTypeLib
"
typeLib := RANDOMLib! !
!IRandomStream methodsFor!
get_LowerBound: pVal
"Private - Get the value of the 'LowerBound' property of the receiver.
Helpstring: 'Lower bound of range of random numbers generated'
HRESULT __stdcall LowerBound(
[out, retval] long* pVal);
"
<virtual stdcall: hresult 11 sdword*>
^self invalidCall
!
get_Seed: pVal
"Private - Get the value of the 'Seed' property of the receiver.
Helpstring: 'Current random seed'
HRESULT __stdcall Seed(
[out, retval] long* pVal);
"
<virtual stdcall: hresult 9 sdword*>
^self invalidCall
!
get_UpperBound: pVal
"Private - Get the value of the 'UpperBound' property of the receiver.
Helpstring: 'Upper bound of range of random numbers generated'
HRESULT __stdcall UpperBound(
[out, retval] long* pVal);
"
<virtual stdcall: hresult 13 sdword*>
^self invalidCall
!
isExtensible
"Answer whether the receiver may add methods at run-time."
^false!
isVBCollection
"Answer whether the receiver is a VB style collection."
^false!
lowerBound
"Answer the <sdword> value of the 'LowerBound' property of the receiver.
Helpstring: 'Lower bound of range of random numbers generated'"
| pVal |
pVal := SDWORD new.
self get_LowerBound: pVal.
^pVal value
!
lowerBound: pVal
"Set the 'LowerBound' property of the receiver to the <sdword> value of the argument.
Helpstring: 'Lower bound of range of random numbers generated'"
self put_LowerBound: pVal
!
next
"Answer the <SDWORD> result of invoking the COM Object's Next() method.
Helpstring: 'Answer the next random number in the stream'"
| plNext |
plNext := SDWORD new.
self Next: plNext.
^plNext value
!
Next: plNext
"Private - Invoke the Next() method of the COM object wrapped by the receiver.
Helpstring: 'Answer the next random number in the stream'
HRESULT __stdcall Next(
[out, retval] long* plNext);
"
<virtual stdcall: hresult 8 sdword*>
^self invalidCall
!
put_LowerBound: pVal
"Private - Set the value of the 'LowerBound' property of the object wrapped by the
receiver to the <sdword> argument, pVal.
Helpstring: 'Lower bound of range of random numbers generated'
HRESULT __stdcall LowerBound(
[in] long pVal);
"
<virtual stdcall: hresult 12 sdword>
^self invalidCall
!
put_Seed: pVal
"Private - Set the value of the 'Seed' property of the object wrapped by the
receiver to the <sdword> argument, pVal.
Helpstring: 'Current random seed'
HRESULT __stdcall Seed(
[in] long pVal);
"
<virtual stdcall: hresult 10 sdword>
^self invalidCall
!
put_UpperBound: pVal
"Private - Set the value of the 'UpperBound' property of the object wrapped by the
receiver to the <sdword> argument, pVal.
Helpstring: 'Upper bound of range of random numbers generated'
HRESULT __stdcall UpperBound(
[in] long pVal);
"
<virtual stdcall: hresult 14 sdword>
^self invalidCall
!
seed
"Answer the <sdword> value of the 'Seed' property of the receiver.
Helpstring: 'Current random seed'"
| pVal |
pVal := SDWORD new.
self get_Seed: pVal.
^pVal value
!
seed: pVal
"Set the 'Seed' property of the receiver to the <sdword> value of the argument.
Helpstring: 'Current random seed'"
self put_Seed: pVal
!
upperBound
"Answer the <sdword> value of the 'UpperBound' property of the receiver.
Helpstring: 'Upper bound of range of random numbers generated'"
| pVal |
pVal := SDWORD new.
self get_UpperBound: pVal.
^pVal value
!
upperBound: pVal
"Set the 'UpperBound' property of the receiver to the <sdword> value of the argument.
Helpstring: 'Upper bound of range of random numbers generated'"
self put_UpperBound: pVal
! !
IWebBrowser comment:
'<IWebBrowser> is a wrapper class for the COM interface ''SHDocVw.IWebBrowser'' generated from type information in the ''Microsoft Internet Controls'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains the following helpstring for this interface
"Web Browser interface"
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
!IWebBrowser class methodsFor!
clsid
"Private - Answer the CLSID of the coclass (WebBrowser_V1) for which the receiver is the default interface."
"Answer the <IDispatch> value of the 'Parent' property of the receiver.
Helpstring: 'Returns the automation object of the container/parent if one exists or this automation object.'"
| answer |
answer := IDispatch newPointer.
self get_Parent: answer.
^answer asObject
!
put_Height: pl
"Private - Set the value of the 'Height' property of the object wrapped by the
receiver to the <sdword> argument, pl.
Helpstring: 'The vertical dimension (pixels) of the frame window/object.'
HRESULT __stdcall Height(
[in] long pl);"
<virtual stdcall: hresult 29 sdword>
^self invalidCall
!
put_Left: pl
"Private - Set the value of the 'Left' property of the object wrapped by the
receiver to the <sdword> argument, pl.
Helpstring: 'The horizontal position (pixels) of the frame window relative to the screen/container.'
HRESULT __stdcall Left(
[in] long pl);"
<virtual stdcall: hresult 23 sdword>
^self invalidCall
!
put_Top: pl
"Private - Set the value of the 'Top' property of the object wrapped by the
receiver to the <sdword> argument, pl.
Helpstring: 'The vertical position (pixels) of the frame window relative to the screen/container.'
HRESULT __stdcall Top(
[in] long pl);"
<virtual stdcall: hresult 25 sdword>
^self invalidCall
!
put_Width: pl
"Private - Set the value of the 'Width' property of the object wrapped by the
receiver to the <sdword> argument, pl.
Helpstring: 'The horizontal dimension (pixels) of the frame window/object.'
HRESULT __stdcall Width(
[in] long pl);"
<virtual stdcall: hresult 27 sdword>
^self invalidCall
!
Refresh
"Invoke the Refresh() method of the COM object wrapped by the receiver.
Helpstring: 'Refresh the currently viewed page.'
HRESULT __stdcall Refresh();"
<virtual stdcall: hresult 13>
^self invalidCall
!
refresh2: level
"Invoke the Refresh2() method of the COM object.
Helpstring: 'Refresh the currently viewed page.'"
^self Refresh2: level asVariant
!
Refresh2: level
"Private - Invoke the Refresh2() method of the COM object wrapped by the receiver.
Helpstring: 'Refresh the currently viewed page.'
HRESULT __stdcall Refresh2(
[in, optional] VARIANT* Level);"
<virtual stdcall: hresult 14 variant*>
^self invalidCall
!
Stop
"Invoke the Stop() method of the COM object wrapped by the receiver.
Helpstring: 'Stops opening a file.'
HRESULT __stdcall Stop();"
<virtual stdcall: hresult 15>
^self invalidCall
!
top
"Answer the <sdword> value of the 'Top' property of the receiver.
Helpstring: 'The vertical position (pixels) of the frame window relative to the screen/container.'"
| answer |
answer := (SDWORD new).
self get_Top: answer.
^answer asObject
!
top: pl
"Set the 'Top' property of the receiver to the <sdword> value of the argument.
Helpstring: 'The vertical position (pixels) of the frame window relative to the screen/container.'"
self put_Top: pl
!
topLevelContainer
"Answer the <varbool> value of the 'TopLevelContainer' property of the receiver.
Helpstring: 'Returns True if this is the top level object.'"
| answer |
answer := (VARIANT_BOOL new).
self get_TopLevelContainer: answer.
^answer asObject
!
type
"Answer the <bstr> value of the 'Type' property of the receiver.
Helpstring: 'Returns the type of the contained document object.'"
| answer |
answer := BSTR new.
self get_Type: answer.
^answer asObject
!
value
"Answer the URL currently under scrutiny.
Implementation Note: The value property on this interface (well actually on the derived interface
<IWebBrowserApp>) is a particularly cretinous choice - the 'application' name, and is read only.
The URL is a more sensible choice."
^self locationURL!
value: value
"Set the special property which is the default value for the receiver."
self navigate: value
!
width
"Answer the <sdword> value of the 'Width' property of the receiver.
Helpstring: 'The horizontal dimension (pixels) of the frame window/object.'"
| answer |
answer := (SDWORD new).
self get_Width: answer.
^answer asObject
!
width: pl
"Set the 'Width' property of the receiver to the <sdword> value of the argument.
Helpstring: 'The horizontal dimension (pixels) of the frame window/object.'"
self put_Width: pl
! !
IWebBrowserApp comment:
'<IWebBrowserApp> is a wrapper class for the COM interface ''SHDocVw.IWebBrowserApp'' generated from type information in the ''Microsoft Internet Controls'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains the following helpstring for this interface
"Web Browser Application Interface."
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
!IWebBrowserApp class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'SHDocVw.IWebBrowserApp'
IWebBrowserApp defineTemplate"
self
defineFunction: #Quit;
defineFunction: #ClientToWindow:pcy:
argumentTypes: 'sdword* sdword*';
defineFunction: #PutProperty:vtValue:
argumentTypes: 'bstr variant';
defineFunction: #GetProperty:pvtValue:
argumentTypes: 'bstr variant*';
defineFunction: #get_Name:
argumentTypes: 'bstr*';
defineFunction: #get_HWND:
argumentTypes: 'sdword*';
defineFunction: #get_FullName:
argumentTypes: 'bstr*';
defineFunction: #get_Path:
argumentTypes: 'bstr*';
defineFunction: #get_Visible:
argumentTypes: 'varbool*';
defineFunction: #put_Visible:
argumentTypes: 'varbool';
defineFunction: #get_StatusBar:
argumentTypes: 'varbool*';
defineFunction: #put_StatusBar:
argumentTypes: 'varbool';
defineFunction: #get_StatusText:
argumentTypes: 'bstr*';
defineFunction: #put_StatusText:
argumentTypes: 'bstr';
defineFunction: #get_ToolBar:
argumentTypes: 'sdword*';
defineFunction: #put_ToolBar:
argumentTypes: 'sdword';
defineFunction: #get_MenuBar:
argumentTypes: 'varbool*';
defineFunction: #put_MenuBar:
argumentTypes: 'varbool';
defineFunction: #get_FullScreen:
argumentTypes: 'varbool*';
defineFunction: #put_FullScreen:
argumentTypes: 'varbool'
! !
!IWebBrowserApp methodsFor!
clientToWindow: pcx pcy: pcy
"Invoke the ClientToWindow() method of the COM Object.
Helpstring: 'Converts client sizes into window sizes.'
Implementation Note: Originally auto-generated, but modified to return a <Point>."
| x y |
x := SDWORD new value: pcx; yourself.
y := SDWORD new value: pcy; yourself.
self
ClientToWindow: x
pcy: y.
^x value @ y value
!
ClientToWindow: pcx pcy: pcy
"Private - Invoke the ClientToWindow() method of the COM object wrapped by the receiver.
Helpstring: 'Converts client sizes into window sizes.'
HRESULT __stdcall ClientToWindow(
[in, out] int* pcx,
[in, out] int* pcy);"
<virtual stdcall: hresult 34 sdword* sdword*>
^self invalidCall
!
fullName
"Answer the <bstr> value of the 'FullName' property of the receiver.
Helpstring: 'Returns file specification of the application, including path.'"
| answer |
answer := BSTR new.
self get_FullName: answer.
^answer asObject
!
fullScreen
"Answer the <varbool> value of the 'FullScreen' property of the receiver.
Helpstring: 'Maximizes window and turns off statusbar, toolbar, menubar, and titlebar.'"
| answer |
answer := (VARIANT_BOOL new).
self get_FullScreen: answer.
^answer asObject
!
fullScreen: pbFullScreen
"Set the 'FullScreen' property of the receiver to the <varbool> value of the argument.
Helpstring: 'Maximizes window and turns off statusbar, toolbar, menubar, and titlebar.'"
self put_FullScreen: pbFullScreen
!
get_FullName: fullName
"Private - Get the value of the 'FullName' property of the receiver.
Helpstring: 'Returns file specification of the application, including path.'
HRESULT __stdcall FullName(
[out, retval] BSTR* FullName);"
<virtual stdcall: hresult 39 bstr*>
^self invalidCall
!
get_FullScreen: pbFullScreen
"Private - Get the value of the 'FullScreen' property of the receiver.
Helpstring: 'Maximizes window and turns off statusbar, toolbar, menubar, and titlebar.'
HRESULT __stdcall FullScreen(
[out, retval] VARIANT_BOOL* pbFullScreen);"
<virtual stdcall: hresult 51 varbool*>
^self invalidCall
!
get_HWND: pHWND
"Private - Get the value of the 'HWND' property of the receiver.
Helpstring: 'Returns the HWND of the current IE window.'
HRESULT __stdcall HWND(
[out, retval] long* pHWND);"
<virtual stdcall: hresult 38 sdword*>
^self invalidCall
!
get_MenuBar: value
"Private - Get the value of the 'MenuBar' property of the receiver.
Helpstring: 'Controls whether menubar is shown.'
HRESULT __stdcall MenuBar(
[out, retval] VARIANT_BOOL* Value);"
<virtual stdcall: hresult 49 varbool*>
^self invalidCall
!
get_Name: name
"Private - Get the value of the 'Name' property of the receiver.
Helpstring: 'Returns name of the application.'
HRESULT __stdcall Name(
[out, retval] BSTR* Name);"
<virtual stdcall: hresult 37 bstr*>
^self invalidCall
!
get_Path: path
"Private - Get the value of the 'Path' property of the receiver.
Helpstring: 'Returns the path to the application.'
HRESULT __stdcall Path(
[out, retval] BSTR* Path);"
<virtual stdcall: hresult 40 bstr*>
^self invalidCall
!
get_StatusBar: pBool
"Private - Get the value of the 'StatusBar' property of the receiver.
Helpstring: 'Turn on or off the statusbar.'
HRESULT __stdcall StatusBar(
[out, retval] VARIANT_BOOL* pBool);"
<virtual stdcall: hresult 43 varbool*>
^self invalidCall
!
get_StatusText: statusText
"Private - Get the value of the 'StatusText' property of the receiver.
Helpstring: 'Text of Status window.'
HRESULT __stdcall StatusText(
[out, retval] BSTR* StatusText);"
<virtual stdcall: hresult 45 bstr*>
^self invalidCall
!
get_ToolBar: value
"Private - Get the value of the 'ToolBar' property of the receiver.
Helpstring: 'Controls which toolbar is shown.'
HRESULT __stdcall ToolBar(
[out, retval] int* Value);"
<virtual stdcall: hresult 47 sdword*>
^self invalidCall
!
get_Visible: pBool
"Private - Get the value of the 'Visible' property of the receiver.
Helpstring: 'Determines whether the application is visible or hidden.'
HRESULT __stdcall Visible(
[out, retval] VARIANT_BOOL* pBool);"
<virtual stdcall: hresult 41 varbool*>
^self invalidCall
!
GetProperty: property pvtValue: pvtValue
"Private - Invoke the GetProperty() method of the COM object wrapped by the receiver.
Helpstring: 'Retrieve the Associated value for the property vtValue in the context of the object.'
HRESULT __stdcall GetProperty(
[in] BSTR Property,
[out, retval] VARIANT* pvtValue);"
<virtual stdcall: hresult 36 bstr variant*>
^self invalidCall
!
getProperty_: property
"Answer the <VARIANT> result of invoking the COM Object's GetProperty() method.
Helpstring: 'Retrieve the Associated value for the property vtValue in the context of the object.'"
| answer |
answer := VARIANT new.
self
GetProperty: property
pvtValue: answer.
^answer asObject
!
hwnd
"Answer the <sdword> value of the 'HWND' property of the receiver.
Helpstring: 'Returns the HWND of the current IE window.'"
| answer |
answer := (SDWORD new).
self get_HWND: answer.
^answer asObject
!
menuBar
"Answer the <varbool> value of the 'MenuBar' property of the receiver.
Helpstring: 'Controls whether menubar is shown.'"
| answer |
answer := (VARIANT_BOOL new).
self get_MenuBar: answer.
^answer asObject
!
menuBar: value
"Set the 'MenuBar' property of the receiver to the <varbool> value of the argument.
Helpstring: 'Controls whether menubar is shown.'"
self put_MenuBar: value
!
name
"Answer the <bstr> value of the 'Name' property of the receiver.
Helpstring: 'Returns name of the application.'"
| answer |
answer := BSTR new.
self get_Name: answer.
^answer asObject
!
path
"Answer the <bstr> value of the 'Path' property of the receiver.
Helpstring: 'Returns the path to the application.'"
| answer |
answer := BSTR new.
self get_Path: answer.
^answer asObject
!
put_FullScreen: pbFullScreen
"Private - Set the value of the 'FullScreen' property of the object wrapped by the
receiver to the <varbool> argument, pbFullScreen.
Helpstring: 'Maximizes window and turns off statusbar, toolbar, menubar, and titlebar.'
HRESULT __stdcall FullScreen(
[in] VARIANT_BOOL pbFullScreen);"
<virtual stdcall: hresult 52 varbool>
^self invalidCall
!
put_MenuBar: value
"Private - Set the value of the 'MenuBar' property of the object wrapped by the
receiver to the <varbool> argument, value.
Helpstring: 'Controls whether menubar is shown.'
HRESULT __stdcall MenuBar(
[in] VARIANT_BOOL Value);"
<virtual stdcall: hresult 50 varbool>
^self invalidCall
!
put_StatusBar: pBool
"Private - Set the value of the 'StatusBar' property of the object wrapped by the
receiver to the <varbool> argument, pBool.
Helpstring: 'Turn on or off the statusbar.'
HRESULT __stdcall StatusBar(
[in] VARIANT_BOOL pBool);"
<virtual stdcall: hresult 44 varbool>
^self invalidCall
!
put_StatusText: statusText
"Private - Set the value of the 'StatusText' property of the object wrapped by the
receiver to the <bstr> argument, statusText.
Helpstring: 'Text of Status window.'
HRESULT __stdcall StatusText(
[in] BSTR StatusText);"
<virtual stdcall: hresult 46 bstr>
^self invalidCall
!
put_ToolBar: value
"Private - Set the value of the 'ToolBar' property of the object wrapped by the
receiver to the <sdword> argument, value.
Helpstring: 'Controls which toolbar is shown.'
HRESULT __stdcall ToolBar(
[in] int Value);"
<virtual stdcall: hresult 48 sdword>
^self invalidCall
!
put_Visible: pBool
"Private - Set the value of the 'Visible' property of the object wrapped by the
receiver to the <varbool> argument, pBool.
Helpstring: 'Determines whether the application is visible or hidden.'
HRESULT __stdcall Visible(
[in] VARIANT_BOOL pBool);"
<virtual stdcall: hresult 42 varbool>
^self invalidCall
!
putProperty: property vtValue: vtValue
"Invoke the PutProperty() method of the COM object.
Helpstring: 'Associates vtValue with the name szProperty in the context of the object.'"
^self
PutProperty: property
vtValue: vtValue asVariant
!
PutProperty: property vtValue: vtValue
"Private - Invoke the PutProperty() method of the COM object wrapped by the receiver.
Helpstring: 'Associates vtValue with the name szProperty in the context of the object.'
HRESULT __stdcall PutProperty(
[in] BSTR Property,
[in] VARIANT vtValue);"
<virtual stdcall: hresult 35 bstr variant>
^self invalidCall
!
Quit
"Invoke the Quit() method of the COM object wrapped by the receiver.
Helpstring: 'Exits application and closes the open document.'
HRESULT __stdcall Quit();"
<virtual stdcall: hresult 33>
^self invalidCall
!
statusBar
"Answer the <varbool> value of the 'StatusBar' property of the receiver.
Helpstring: 'Turn on or off the statusbar.'"
| answer |
answer := (VARIANT_BOOL new).
self get_StatusBar: answer.
^answer asObject
!
statusBar: pBool
"Set the 'StatusBar' property of the receiver to the <varbool> value of the argument.
Helpstring: 'Turn on or off the statusbar.'"
self put_StatusBar: pBool
!
statusText
"Answer the <bstr> value of the 'StatusText' property of the receiver.
Helpstring: 'Text of Status window.'"
| answer |
answer := BSTR new.
self get_StatusText: answer.
^answer asObject
!
statusText: statusText
"Set the 'StatusText' property of the receiver to the <bstr> value of the argument.
Helpstring: 'Text of Status window.'"
self put_StatusText: statusText
!
toolBar
"Answer the <sdword> value of the 'ToolBar' property of the receiver.
Helpstring: 'Controls which toolbar is shown.'"
| answer |
answer := (SDWORD new).
self get_ToolBar: answer.
^answer asObject
!
toolBar: value
"Set the 'ToolBar' property of the receiver to the <sdword> value of the argument.
Helpstring: 'Controls which toolbar is shown.'"
self put_ToolBar: value
!
value
"Answer the <bstr> value of the 'Name' property of the receiver.
This is the default value (DISPID_VALUE) property of the receiver."
^self name
!
visible
"Answer the <varbool> value of the 'Visible' property of the receiver.
Helpstring: 'Determines whether the application is visible or hidden.'"
| answer |
answer := (VARIANT_BOOL new).
self get_Visible: answer.
^answer asObject
!
visible: pBool
"Set the 'Visible' property of the receiver to the <varbool> value of the argument.
Helpstring: 'Determines whether the application is visible or hidden.'"
self put_Visible: pBool
! !
IWebBrowser2 comment:
'<IWebBrowser2> is a wrapper class for the COM interface ''SHDocVw.IWebBrowser2'' generated from type information in the ''Microsoft Internet Controls'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains the following helpstring for this interface
"Web Browser Interface for IE4."
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
!IWebBrowser2 class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'SHDocVw.IWebBrowser2'
"Answer the <varbool> value of the 'Silent' property of the receiver.
Helpstring: 'Controls if any dialog boxes can be shown'"
| answer |
answer := (VARIANT_BOOL new).
self get_Silent: answer.
^answer asObject
!
silent: pbSilent
"Set the 'Silent' property of the receiver to the <varbool> value of the argument.
Helpstring: 'Controls if any dialog boxes can be shown'"
self put_Silent: pbSilent
!
theaterMode
"Answer the <varbool> value of the 'TheaterMode' property of the receiver.
Helpstring: 'Controls if the browser is in theater mode'"
| answer |
answer := (VARIANT_BOOL new).
self get_TheaterMode: answer.
^answer asObject
!
theaterMode: pbRegister
"Set the 'TheaterMode' property of the receiver to the <varbool> value of the argument.
Helpstring: 'Controls if the browser is in theater mode'"
self put_TheaterMode: pbRegister
! !
IEnumCATEGORYINFO comment:
'<IEnumCATEGORYINFO> is a wrapper class for the COM interface ''COMCAT.IEnumCATEGORYINFO'' generated from type information in the ''OLE Component Categories Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'<IEnumConnections> is a wrapper class for the custom interface ''OBJIDL.IEnumConnections'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
IEnumConnections is used to enumerate details (via the CONNECTDATA structure) of connection points available in a connection point container.'!
'<IEnumGUID> is a wrapper class for the COM interface ''COMCAT.IEnumGUID'' generated from type information in the ''OLE Component Categories Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
!IEnumGUID class methodsFor!
defineFunctions
"Declare the virtual function table for the COM interface 'COMCAT.IEnumGUID'
IEnumGUID defineTemplate
"
"This method only present to prevent auto-generation from a type library"!
elementClass
"Answer the class of element enumerated by the receiver."
^GUID! !
IEnumRECT comment:
'IEnumRECT is a sample specialization of the generic COM enumeration interface, IEnumXXX.
See p115, Chapter2, "Inside OLE 2e", Kraig Brockschmidt, Microsoft Press.
In Dolphin each COM interface is represented as a class, derived from the IUnknown class, which, not surprisingly, implements the IUnknown interface. The IEnumRECT interface Kraig defines is implemented in Dolphin as a subclass of IEnumXXXX, which provides a generic implementation for COM enumerators, and consequently IEnumRECT need only define a single method, #elementClass, which answers the type of object being enumerated over. Occassionally enerators may require a little more effort (for example when there is memory or ref. counts to be managed), but #elementClass is typically all there is to it.
'!
!IEnumRECT class methodsFor!
elementClass
"Answer the class of element enumerated by the receiver."
^RECT! !
IEnumSTATSTG comment:
'IEnumSTATSTG is a COMInterface class to represent the standard COM interface of the same name.
IEnumSTATSTG is an enumerator for traversing the STATSTG structures containing status information about the individual sub-storages and streams within an IStorage - i.e. it is similar to a directory listing object for COM structured storage files.
Example:
s := IStorage open: ''<a word document>.doc''.
s directory collect: [:i | i name]
IStorage>>directory connects an <OLEEnumerator> collection object to an instance of the receiver which can then be accessed as a <sequencedReadableCollection>.'!
'<IEnumString> is a wrapper class for the custom interface ''OBJIDL.IEnumString'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!IEnumString class methodsFor!
defineFunctions
"Declare the virtual function table for the receiver.
self defineTemplate
"
"This method only present to prevent auto-generation from a type library"!
elementClass
"Answer the class of element enumerated by the receiver."
^LPWSTR! !
IEnumUnknown comment:
'<IEnumUnknown> is a wrapper class for the custom interface ''OBJIDL.IEnumUnknown'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
IEnumUnknown and subclasses are used for enumerating over collections of COM interface pointers.
Implementation Note: IUnknown>>fromAddress: increments the reference count of the COM object it wraps, the result is effectively a standalone pointer which is valid outside the scope of the original owner of the pointer. This means that it is not necessary to take any special action here to extend the life of the objects pulled back by nextAvailable[:] since there lifetime is independent of the buffer used to retrieve them.'!
!IEnumUnknown class methodsFor!
defineFunctions
"Declare the virtual function table for the receiver.
self defineTemplate
"
"This method only present to prevent auto-generation from a type library"!
elementClass
"Answer the class of element enumerated by the receiver."
'<IEnumVARIANT> is a wrapper class for the custom interface ''stdole.IEnumVARIANT'' from type information in the ''OLE Automation'' library. It contains methods to invoke the member functions exposed by that interface.
Implementation Notes: We have to be careful here to manage the lifetime of the VARIANTs correctly. This necessitates overrides of a couple of superclass methods in order to make sure that the objects/collections answered have a lifetime independent of the buffer originally used to retrieve them with the interface Next() function. It is also convenient to immediately convert the variants to their underlying value.
'<IEnumConnectionPoints> is a wrapper class for the custom interface ''OBJIDL.IEnumConnectionPoints'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
IEnumConnections is used to enumerate details (via the CONNECTDATA structure) of connection points available in a connection point container.'!
'<IPersistMemory> is a wrapper class for the COM interface ''OCIDL.IPersistMemory'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
Warning: This comment was automatically generated from the interface''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'<IPersistStream> is a wrapper class for the custom interface ''OBJIDL.IPersistStream'' generated from type information in the ''ObjIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
'<IProvideClassInfo2> is a wrapper class for the COM interface ''OCIDL.IProvideClassInfo2'' generated from type information in the ''OCIDL Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface
IProvideClassInfo2 extends IProvideClassInfo by adding a method to enquire the <GUID>s for various aspects of the COM objects coclass. At present the only aspect defined is the IID of the default source (event) interface.'!
'IStream is a COMInterface class to wrap the standard OLE/COM structured storage interface of the same name.
IStream expands on ISequentialStream to offer the ability to access and adjust the current stream position, and to lock ranges of bytes in the underlying device (ILockBytes). It also offers transactional control, "directory" information, and copying. IStream is widely implmented and (in particular) used by COM objects for persistent storage purposes, marshalling, etc.
This interface class was originally automatically generated from a type library itself generated from the MS IDL file ''objidl.idl''. Our implementation also adds additional streaming capabilites in order that IStream pointers can be used interchangeably with standard Smalltalk streams, e.g. as a destination for binary filing. In fact IStream implements the ANSI standard stream protocols <puttableStream> and <gettableStream>.
We have also implemented the <streamableFile> protocol on IStreams so that a <FileStream> can be layered on top to take advantage of the latters high-performance buffering. This significantly reduces the number of calls made through the interface, and is the preferred mode of operation in most cases as it is much more efficient. It also allows the IStream to be treated as a gettable text stream (we only support binary streams for reading here).
Example:
stm := IStream onHGLOBAL. "Create an OLE stream onto a block of memory..."
''Hello'' binaryStoreOn: stm. "...STB an object onto it..."
stm reset. "...rewind..."
(STBInFiler on: stm) next. "...rehydrate the STB''d object..."
stm close. "...finally, close the stream (though finalization would do this anyway."'!
'''ITypeInfo2 is an interface pointer class to wrap COM interfaces of the same name.
ITypeInfo2 is a refinement of ITypeInfo which adds some bits Microsoft forget about when the defined ITypeInfo, it also adds some capabilities to look up certain pieces of commonly used information that probably made VB quicker. However as we cache the TYPEATTR once retrieved, it is unlikely that ITypeInfo2 will be quicker within Dolphin.
⌡]7 >1¬ï_C╙δ¡$û(Σ╞»╪÷╥ƒ╟╗±áZU║⌐çh3\O┬ü5[Ö[bo^n⌠ä i ╖tV*ûÆ▀⌡k.î≈▓ÉΓ┬ û`W`)ö■ X├ú⌐EöÇp╝¬·h²_\ =≤$┼â╕u[₧$ ╩å╞σî«vƒC≥±·o
ó≈cºt>bÆΩ╫╤[╜.┬L═ßc ô«F├L}╫:ú£éWG║⌐÷√Σ/ªαe[╝≥! !
ITypeLib2 comment:
'<ITypeLib2> is a wrapper class for the COM interface ''OAIDL.ITypeLib2'' generated from type information in the ''Ole Automation Type Library'' library. It contains methods to invoke the member functions exposed by that interface.
The type library contains no documentation for this interface.
WARNING: This comment was automatically generated from the interface''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
"Answer the class of <ExternalStructure> used to represent elements of the receiver."
^DOUBLE! !
DWORDArray comment:
'Specialized <ExternalArray> to represent contiguous single-dimensioned arrays of 32-bit unsigned integers.'!
!DWORDArray class methodsFor!
elementSize
"Private - Answer the size of the receiver's constituent elements."
^4! !
!DWORDArray methodsFor!
at: index
"Answer the 32-bit unsigned integer value at the specified index in the receiver."
^bytes dwordAtOffset: (index - 1) * 4!
at: index put: value
"Replace the 32-bit unsigned integer value at the specified index in the receiver
with the Integer argument, value."
^bytes dwordAtOffset: (index - 1) * 4 put: value!
elementClass
"Answer the class of <ExternalStructure> used to represent elements of the receiver."
^DWORD! !
FLOATArray comment:
'Specialized <ExternalArray> to represent contiguous single-dimensioned arrays of single-precision (32-bit) floating point numbers.'!
!FLOATArray class methodsFor!
elementSize
"Private - Answer the size of the receiver's constituent elements."
^4! !
!FLOATArray methodsFor!
at: index
"Answer the single-precision floating point value at the specified index in the receiver."
^bytes floatAtOffset: (index - 1) * 4!
at: index put: value
"Replace the single-precision floating point value at the specified index in the receiver
with the Float argument, value."
^bytes floatAtOffset: (index - 1) * 4 put: value!
elementClass
"Answer the class of <ExternalStructure> used to represent elements of the receiver."
^FLOAT! !
OLECountedArray comment:
'OLECountedArray is an abstract base class for counted array structures used by various OLE/COM interfaces to input/output variable length arrays, where the array storage is allocated from COM task memory.'!
!OLECountedArray class methodsFor!
clear: addressOrBytes
"Free an instance of the structure which instances of the receiver wrap
"Evaluate the <dyadicValuable>, operation, for each element of the receiver
between the <integer> indices, start and stop, inclusive with the element and its
index as respectively the second and first arguments."
self elements from: start to: stop keysAndValuesDo: operation!
initialize
"Private - Initialize the receiver (common to internal [value] and
external [reference] buffers.
These objects are finalizable since they may reference owned external
resources."
self beFinalizable!
length
"Answer the number of elements in the receiver."
^length := self cElems!
needsFree
"Private - Answer whether the receiver requires freeing of any external resources.
In most cases we don't want to free if this object is a reference to a structure
embedded in an buffer, since that would damage the buffer.
i.e. it is considered that 'reference' structs do not own the underlying structure as
this is what is required, for example, in conjunction with StructureArray."
^self notNull and: [self isPointer not]!
onStartup
"Private - The system is starting. Modify the state of the receiver to account for the fact
than any external memory allocated for the receiver during the previous session is no
longer accessible."
self beUnfinalizable.
self isPointer ifTrue: [
bytes := nil]!
pElems
"Answer the receiver's pElems field as a Smalltalk object."
^(bytes dwordAtOffset: 4) asExternalAddress!
pElems: anObject
"Set the receiver's pElems field to the value of anObject."
bytes dwordAtOffset: 4 put: anObject! !
SAFEARRAY comment:
'SAFEARRAY is an <ExternalArray> class to represent the OLE Automation arrays.
SAFEARRAYs are a flexible representation of potentially multiple dimensioned arrays of almost any of the Variant (Visual Basic) types.
SAFEARRAY has similar behaviour (and indeed implementation) to <StructureArray> in providing a means to map externally implemented arrays of values to appropriate Smalltalk objects (mostly from the <ExternalStructure> hierarchy).
Note that the reported length of a SAFEARRAY is actually the length of the rightmost (least significant) dimension.
Instance Variables:
elementClass <ExternalStructure>|<BSTR>. The variant compatible external type of the elements in the array.
data <ExternalAddress>. Pointer to data of array, when locked.
owner <Object>. Object responsible for freeing the SAFEARRAY. Typically self.
start <integer>. Lower bound of rightmost (least significant) dimension.
'Generic <ExternalArray> class which can represent single-dimensioned arrays of any class of <ExternalStructure>. Packing and alignment rules are respected.
Note that although StructureArray is capable of fulfilling the tasks of other more specialized <ExternalArray> classes such as <DWORDArray> and <FLOATArray>, it is far less efficient and marginally more inconvenient as indexed access always yields an <ExternalStructure> rather than a fundamental Smalltalk object.
Instance Variables:
elementClass <ExternalStructure>. Class to represent elements of the array.
elementSpacing <integer>. Distance (in bytes) between adjacent elements, there may be padding.
owner <Object>. The object that owns the data held in the receiver, or nil if the receiver owns it (and should free it).
'!
!StructureArray class methodsFor!
elementSize
"Private - Answer the size of the receiver's instances' constituent
elements in bytes. We only know this on an instance specific basic."
"Answer the signed 32-bit Integer value of the receiver."
^bytes sdwordAtOffset: 0!
highSWord
"Answer the high-order signed word of the receiver. Assumes little-endian
ordering."
^bytes swordAtOffset: 2!
highSWord: anInteger
"Set the high-order signed word of the receiver. Assumes little-endian
ordering. Answer the receiver."
bytes swordAtOffset: 2 put: anInteger!
highWord
"Answer the high-order word of the receiver. Assumes little-endian
ordering."
^bytes wordAtOffset: 2!
highWord: anInteger
"Set the high-order word of the receiver. Assumes little-endian
ordering. Answer the receiver."
bytes wordAtOffset: 2 put: anInteger!
lowSWord
"Answer the low-order signed word of the receiver. Assumes little-endian
ordering."
^bytes swordAtOffset: 0!
lowSWord: anInteger
"Answer the low-order signed word of the receiver. Assumes little-endian
ordering. Answer the receiver."
bytes swordAtOffset: 0 put: anInteger!
lowWord
"Answer the low-order word of the receiver. Assumes little-endian
ordering."
^bytes wordAtOffset: 0!
lowWord: anInteger
"Answer the low-order word of the receiver. Assumes little-endian
ordering. Answer the receiver."
bytes wordAtOffset: 0 put: anInteger!
value
"Answer the receiver's value field as a Smalltalk object."
^(bytes dwordAtOffset: 0)!
value: anObject
"Set the receiver's value field to the value of anObject."
bytes dwordAtOffset: 0 put: anObject! !
QWORD comment:
'<QWORD> is an abstract superclass for the two Win32 64-bit integer structures, LARGE_INTEGER (signed), and ULARGE_INTEGER (unsigned).
This class of structures is useful for communication with Win32 services that require 64-bit integer parameters. They also provide for easy access to the high and low 32-bit constituents of the integer''s native representation (Intel format 2''s complement).'!
!QWORD class methodsFor!
defineTemplate
"Initialize the receiver class' structure template."
"Answer the severity of the HRESULT (1 for errors, otherwise 0)."
^(self asInteger bitShift: -31) bitAnd: 16r1!
statusCode
"Answer the Win32 status code extracted from the receiver.
#define HRESULT_CODE(hr) ((hr) & 0xFFFF)"
^self asUnsignedInteger bitAnd: 16rFFFF!
succeeded
"Answer whether the receiver represents the result of a successful operation
(named for compatibility with the C/C++ SUCCEEDED macro)."
^self failed not! !
VARIANT_BOOL comment:
'VARIANT_BOOL is an <ExternalStructure> class to represent the Automation type, VARIANT_BOOL, which is VB''s boolean type.
VARIANT_BOOL is a 16-bit signed integer value where -1 is used to represent true, and 0 is used to represent false. This class has a slightly looser definition in that it maps any non-zero value to true on access, and any non-zero/true value to -1 on mutation.'!
'ExternalPointer is a class to represent pointers to arbitrary blocks of externally allocated memory where the size of the block is known and can be associated with the pointer.'!
!ExternalPointer methodsFor!
byteSize
"Answer the size of the memory block at which the receiver is pointing."
^byteSize
!
byteSize: anInteger
"Record the size of the memory block at which the receiver is pointing."
byteSize := anInteger
!
initialize: anInteger
"Initialize the receiver to be a pointer to the specified size of memory block."
super initialize: anInteger.
byteSize := anInteger!
size
"Answer the size of the memory block at which the receiver is pointing."
^byteSize
! !
LPBSTR comment:
'LPBSTR is a class to represent pointers to BSTRs (Basic Strings). It is useful where an IDispatch method requires that a BSTR argument be passed by references, or when implement such a method as a means of returning a BSTR reference.
LPBSTR implicitly converts to the referenced string when asked for its value, rather than answering the pointer value itself.
Note that because BSTR is an indirection class (BSTRs are pointers to strings), it is necessary to send its instances #basicYourAddress to get the address of the object, rather than #yourAddress which will return the contained address.
'LPSTR is a class to represent pointers to single-byte strings. It is useful where an external function returns a pointer to a character string through a pointer argument, or where a callback function passes in a pointer to a string as an output parameter to be populated.
LPSTR implicitly converts to the referenced string when asked for its value, rather than answering the pointer value itself.'!
!LPSTR methodsFor!
asString
"Answer a String composed of the characters of the receiver, or
the empty string if the receiver is a null pointer."
^self value!
value
"Answer the UnicodeString pointed at by the receiver (N.B. it is copied into Smalltalk space)"
^String fromAddress: super value! !
LPWSTR comment:
'LPWSTR is a class to represent pointers to Unicode strings. It is useful where an external function (or COM method call) returns a pointer to a wide character string through a pointer argument. An example being the IEnumString interface.
LPWSTR implicitly converts to the referenced Unicode string when asked for its value, rather than answering the pointer value itself.
'!
!LPWSTR methodsFor!
asString
"Answer a String composed of the characters of the receiver, or
the empty string if the receiver is a null pointer."
^self value asString!
value
"Answer the UnicodeString pointed at by the receiver (N.B. it is copied into Smalltalk space)"
^UnicodeString fromAddress: super value! !
ARRAYDESC comment:
'ARRAYDESC is an ExternalStructure class to represent the COM Automation structure of the same name.
ARRAYDESC describes an Automation safe array, specifically the type of the elements, the number of dimensions, and the bounds for each dimension.
Member variables:
tdescElem <TYPEDESC> Type of the elements of the array
'<CATEGORYINFO> is an <ExternalStructure> class to wrap the struct ''COMCAT.CATEGORYINFO'' from type information in the ''OLE Component Categories Library'' library.
CATEGORYINFO is used in conjunction with ICatInformation>>EnumCategories() to enumerate details of the categories registered on the host machine.'!
'<COAUTHIDENTITY> is an <ExternalStructure> class to wrap the struct ''OBJIDL.COAUTHIDENTITY'' from type information in the ''ObjIDL Library'' library.
The type library contains no documentation for this struct
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
!COAUTHIDENTITY class methodsFor!
defineFields
"Define the fields of the COAUTHIDENTITY structure.
defineField: #PasswordLength type: DWORDField new offset: 20;
defineField: #Flags type: DWORDField new offset: 24.
self byteSize: 28! !
COAUTHINFO comment:
'<COAUTHINFO> is an <ExternalStructure> class to wrap the struct ''OBJIDL.COAUTHINFO'' from type information in the ''ObjIDL Library'' library.
The type library contains no documentation for this struct
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
!COAUTHINFO class methodsFor!
defineFields
"Define the fields of the COAUTHINFO structure.
COAUTHINFO compileDefinition
typedef struct tagCOAUTHINFO {
unsigned long dwAuthnSvc;
unsigned long dwAuthzSvc;
LPWSTR pwszServerPrincName;
unsigned long dwAuthnLevel;
unsigned long dwImpersonationLevel;
COAUTHIDENTITY* pAuthIdentityData;
unsigned long dwCapabilities;
} COAUTHINFO;
"
self
defineField: #dwAuthnSvc type: DWORDField new offset: 0;
defineField: #dwAuthzSvc type: DWORDField new offset: 4;
defineField: #dwCapabilities type: DWORDField new offset: 24.
self byteSize: 28! !
CONNECTDATA comment:
'<CONNECTDATA> is an <ExternalStructure> class to wrap the struct ''OBJIDL.CONNECTDATA'' from type information in the ''ObjIDL Library'' library.
The type library contains no documentation for this struct
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'CURRENCY is an <ExternalStructure> class to represent the Automation structure of the same name.
CURRENCY is a 64-bit fractional value scaled by 10000 to give 4 decimal places. It provides limited scaled decimal capabilities for simple scripting languages such as VB. It corresponds to the variant type VT_CY.
CURRENCYs are mapped to/from Dolphin''s <ScaledDecimal> objects, although of course the latter has unlimited range, and therefore many ScaledDecimals cannot be represented in a CURRENCY.'!
≈E+0U╬µp┤║¢/ù⌡▄Ωî∞╥▄╨╖ΣáA¼√╓z]SÆà-û w'oW_·è^U%N»yWNº¿)≈▀N^µ⌡┌⌠ÜÑu ▀g[ h ┘Ñ"c■ÖÉ ╒Ç%v»O│y┤ XB4╗$╦│3!
≈E+0bΣü7>î¿Ç?ÇRï╜¡ √├ƒ┴╢≈σAF╝╛╔mvZ┴─(S¢JAjzT≤┴Bws+Mªn&ΓÑ%φΦC ╜▓∙▄ÜÑqt■g[ h ┘Ñ7rµ╟┼N~öå5Στ-└Q¼+╚jï█^ÖP! !
CUSTDATAITEM comment:
'<CUSTDATAITEM> is an <ExternalStructure> class to wrap the struct ''OAIDL.CUSTDATAITEM'' from type information in the ''Ole Automation Type Library'' library.
The type library contains no documentation for this struct
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'DECIMAL is an ExternalStructure class to represent the Automation structure of the same name.
DECIMAL is a rather complex 16-byte fixed point value with 12-bytes to represent the absolute value, and a byte each for scale and sign, with the top two bytes unused so that a DECIMAL can be stored safely in a VARIANT without overwriting the vartype. DECIMAL corresponds to VT_DECIMAL.
DECIMALs are mapped to/from Dolphin''s <ScaledDecimal> objects, although of course the latter has unlimited range, and therefore not all ScaledDecimals can be represented in a DECIMAL.'!
'DISPPARAMS is an <ExternalStructure> to represent the OLE Automation structure DISPPARAMS.
DISPPARAMS is the parameter block used in calls to IDispatch::Invoke. It contains an array of VARIANTARG structures (which are actually represented by the identical <VARIANT> structure in Dolphin), a count of the total number of arguments, an array of the <integer> DISPIDs of the so called "named" arguments, and a count of the number of named arguments in that array. The named arguments are assumed to appear first in the rgvarg array.
In general Dolphin does not use named arguments since these are not terribly well supported by Smalltalk syntax. The exception is for property put invocations, where their use is required.
Apart from the generated accessors for the structure members this class implements convenience methods to make it easy to set up late-bound calls of common types.
Fields:
rgvarg <VARIANT*> Array of arguments
rgdispidNamedArgs <SDWORD*> Array of ids of named arguments
cArgs <DWORD> Total number of named and unnamed arguments (size of rgvarg).
cNamedArgs <DWORD> Number of named arguments (size of rgdispidNamedArgs)'!
'FONTDESC is an <ExternalStructure> class to represent the OLE structure of the same name.
FONTDESC is similar to a LOGFONT in that it represents a logical description of a Font, although in this case an OLE Font object (see IFont and IFontDisp). FONTDESC is simpler than LOGFONT, however.'!
'IDLDESC is an <ExternalStructure> class to represent the AX Automation structure, IDLDESC.
IDLDESC contains basic marshalling information for a function argument, basically consisting of flags which relate to attributes such as ''in'', ''out'' and ''retval'', which are defined in the IDL for the argument.
Member variables:
dwReserved <DWORD> "reserved for future use"
wIDLFlags <WORD> Flags from the IDLFLAGS enumeration.
Note that this structure is only 6-bytes long, and may require packing when embedded in other structures.'!
!IDLDESC class methodsFor!
σA!!;=éå7%╛║ß@∞}┼╤Θ┼≡╥ƒ┴╢≈σUJ║╖─h3GPÆÉ6W╫v`J~`HOσò Le2Z▒y ╚╞Jô╖k$äôÆ¡╘Å ÜdW kD▀║d<º▌╔VF█{∙{ ╟*Ñié E ═@║φz±( ┼Q╣√¬ƒ∙î\ª*▀ƒäN
'LICINFO is an ExternalStructure class to represent the COM structure of the same name. LICINFO is used for licensing purposes in conjunction with IClassFactory2. Please refer to COM reference materials for further information.
Member variables:
* cbLicInfo <DWORD> sizeof the LICINFO structure
fRuntimeKeyAvail; <Boolean>
fLicVerified <Boolean>
*Renamed dwSize for compatibility with standard initialization code.'!
"Set the receiver's dwSize field to the value of anObject.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated."
bytes dwordAtOffset: 0 put: anObject!
fLicVerified
"Answer the receiver's fLicVerified field as a Smalltalk object.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated."
^(bytes dwordAtOffset: 8) asBoolean!
fRuntimeKeyAvail
"Answer the receiver's fRuntimeKeyAvail field as a Smalltalk object.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated."
^(bytes dwordAtOffset: 4) asBoolean! !
OLEFinalizableStructure comment:
''!
!OLEFinalizableStructure class methodsFor!
clear: addressOrBytes
"Free external resources referenced by the structure
of the receiver's element type at the specified address."
^self subclassResponsibility!
initialize
"Private - Initialize the receiver.
Register with session events to clean up sub-instances on startup.
OLEFinalizableStructure initialize
"
SessionManager current
when: #sessionStarted send: #onStartup to: self
!
onStartup
"Private - Notify all the receiver's sub-instances of system startup."
self primAllSubinstances do: [:i | i onStartup].!
uninitialize
SessionManager current removeEventsTriggeredFor: self! !
!OLEFinalizableStructure methodsFor!
initialize
"Private - Initialize the receiver which is an internal [value] buffer.
These objects are finalizable since they may reference owned external
resources."
self beFinalizable!
needsFree
"Private - Answer whether the receiver requires freeing of any external resources.
In most cases we don't want to free if this object is a reference to a structure
embedded in an buffer, since that would damage the buffer.
i.e. it is considered that 'reference' structs do not own the underlying structure as
this is what is required, for example, in conjunction with StructureArray."
^self notNull and: [self isPointer not]!
onStartup
"Private - The system is starting. Modify the state of the receiver to account for the fact
than any external memory allocated for the receiver during the previous session is no
longer accessible."
self beUnfinalizable.
self isPointer ifTrue: [
bytes := nil]! !
PARAMDESC comment:
'PARAMDESC is an <ExternalStructure> to represent the AX Automation structure of the same name.
The PARAMDESC structure is used, one per argument, to describe the parameters to a function belonging to either an [disp]interface or a module in a type library. The information includes certain (but not all) IDL flags, as well as the argument
type and default value, if any.
Fields:
pparamdescex <PARAMDESCEX*> pointer to a struct with default value for the parameter, if any.
wParamFlags <WORD> various flags describing the parameter, such as whether it is [in] or [out].'!
'<SAFEARRAYBOUND> is an <ExternalStructure> class to wrap the struct ''''OAIDL.SAFEARRAYBOUND'''' from type information in the ''''Ole Automation Type Library'''' library.
A SAFEARRAYBOUND describes one dimension of a SAFEARRAY, or C array when used to describe a VT_CARRAY in a <TYPEDESC>.'!
'TYPEDESC is an ExternalStructure class to represent the AX Automation structure, TYPEDESC.
The TYPEDESC structure describes the type of a variable, function parameter, or return value, and is one of the key structures in the type library model.
Member Variables:
u
lptdesc <TYPEDESC*> For a VT_PTR|VT_SAFEARRAY, describes the pointed at type
lpadesc <ARRAYDESC*> For a VT_CARRAY, provides additional description of the array
hreftype <HREFTYPE> For a VT_USERDEFINEDTYPE, ?
vt <VARTYPE> Variant type id (16-bits)
Note that this structure is only 6-bytes long, and requires packing when embedded in other structures (Dolphin''s external structure/array packing and alignment algorithm will handle this automatically).
Instance Variables:
owner <ExternalStructure>. Backpointer to original structure to keep it alive, and also to locate ITypeInfo.
'AXTypeInfoStructure is the class of <ExternalStructure>s representing the OLE Automation structures used in conjunction with <ITypeInfo>. AXTypeInfoStructure itself is abstract.
Note that all subinstances of the receiver are allocated by an ITypeInfo and must be released by that same ITypeInfo. We achieve this by a backpointer to the allocating ITypeInfo/AXTypeInfoAnalyzer, and by marking the subinstance as finalizable. This does mean that holding onto one of these structures will cause the originating ITypeInfo to persist as well.
Instance variables:
piTypeInfo <ITypeInfo> which allocated the struct and which must free it.
analyzer <AXTypeInfoAnalyzer> which wraps piTypeInfo, and can analyze the receiver (may be nil)
'<CUSTDATA> is an <ExternalStructure> class to wrap the struct ''OAIDL.CUSTDATA'' from type information in the ''Ole Automation Type Library'' library.
The type library contains no documentation for this struct
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.'!
'EXCEPINFO is the class of <ExternalStructure>s representing the OLE Automation structure of the same name. EXCEPINFO is used to return exception details from IDispatch::Invoke().'!
!EXCEPINFO class methodsFor!
clear: addressOrBytes
"Free external resources referenced by the structure
of the receiver's element type at the specified address."
'MULTI_QI is an <ExternalStructure> class to represent the Win32 COM structure of the same name.
Arrays of MULTI_QI structures can be used to query multiple interface pointers in a single request. This is only really important for DCOM as it helps to minimize the number of network round-trips that are performed.'!
!MULTI_QI class methodsFor!
clear: addressOrBytes
"Free external resources referenced by the structure
of the receiver's element type at the specified address."
'STATSTG is an <ExternalStructure> class to represent the OLE Structured Storage structure of the same name.
STATSTG contains directory type information about a structured storage object (storage, stream, or lock bytes)
N.B. The pwcsName member is a pointer to a UnicodeString that has been allocated from the COM task heap, and which must be free''d back to that heap. This is managed using finalization.
Member variables:
pwcsName <UnicodeString> "file" name
type <integer> from STGTY enumeration - the type of storage object
cbSize <integer> size in bytes
mtime <FILETIME> when last modified
ctime <FILETIME> when created
atime <FILETIME> when last accessed
grfMode <integer> access mode
grfLocksSupported <integer> from LOCKTYPES enumeration - the types of lock supported
clsid <CLSID> of storage object
grfStateBits <integer> bit mask last set by IStorage>>SetStateBits
dwStgFmt <integer> from STGFMT enumeration - the format of the storage object.'!
'VARIANT is an <ExternalStructure> to represent the OLE Automation VARIANT and VARIANTARG types.
A VARIANT is basically a discriminated union which can represent all the parameter types which can be passed to and returned from member functions of Automation compatible (oleautomation) interfaces by Automation controllers and servers. These types are constrained by those which VB can handle, and hence there are no unsigned integers. A VARIANT''s type tag is stored as a 16-bit <integer> at the start of the structure, and is accessing with the #vt/vt: methods. Note that not all of the VT_XXX types are actually supported by the various variant manipulation functions provided by the Automation library, e.g. VT_LPSTR, as some are intended for type description and other purposes.
One complexity of VARIANTs worth noting is that they may, when used as arguments (i.e. VARIANTARGs) be used to pass parameters by reference. In this case they contain a pointer to the actual data, and the flag VT_BYREF is bitOr''d with the basic VT_XX data type tag. Dolphin handles this usage transparently such that no difference is perceived by users of this class.
It is worth noting that with the default Win32 packing (Zp8), VARIANT aligns on 8 byte boundaries, and may therefore make structures in which it is embedded larger than expected (this is handled correctly by Dolphin''s structure packing algorithm).
Class Variables:
Accessors <LookupTable> mapping variant type codes to accessor methods for extracting an object of that type.
═N* @+Q╖p⃿Ñφ)ÅBπºi┼σ≥)î1}1Z²φ╛\╝ô⌐╕D├≤] ≥"*9∙Ü:r¡ò▒·\¼┬I▐╘\ïäKåæφz3¬vσ)/û$nlv¿ΩcwE~c¡«╡¿Γfón╔πoò╜▒W≡╦'-lB╙n╬2^nç┴ó*¬ V gm²╕¡∞=`╖√jaM╒ùÇrïw╠δ┬'ªb=ë■░}█╡Kùô1╝▓]jB!
'TYPEATTR is an <ExternalStructure> class to represent the Active-X Automation TYPEATTR structure.
TYPEATTR contains a number of attributes describing a particular type info. element of a type library. Unfortunately it is overloaded (like its originator ITypeInfo) with the job of describing all of the different types of object for which type information may be present in the library (i.e. interfaces, typedefs, enums, coclasses, dispinterfaces, unions, structs, and modules). This means that some of the members may not be relevant to the programming element described. In general we access the members of this structure through the relevant subclass of AXTypeInfoAnalyzer, thus benefitting from the correct factoring of that hierarchy.
Fields:
guid <GUID> Unique id of the programming element.
lcid <DWORD> Locale identifier. Type information can be locale specific.
dwReserved <DWORD>
memidConstructor <SDWORD> Unique id of the constructor method (not used).
memidDestructor <SDWORD> Unique id of the destructor method (not used)
lpstrSchema <LPWSTR>. Not used.
cbSizeInstance <DWORD> Size in bytes of instances of the programming element, if relevant.
typekind <SDWORD> from the TYPEKIND enum. Type of the programming element, e.g. interface.
cFuncs <WORD> Number of functions/methods in the programming element.
cVars <WORD> Number of properties/variables/fields in the programming element.
cImplTypes <WORD>
cbSizeVft <WORD> Size of the virtual table in bytes. N.B. Implies max. 16398 vfns, but see FUNCDESC.
cbAlignment <WORD> Alignment requirement of the programming element when embedded in a structure.
wTypeFlags <WORD> Various flags, set varies by typekind.
wMajorVerNum <WORD> Major version number.
wMinorVerNum <WORD> Minor version number
tdescAlias <TYPEDESC> for which this is an alias (typedef).
idldescType <IDLDESC> providing information about the originating IDL.
'ACCEL is an <ExternalStructure> class to represent the Win32 structure of the same name.
ACCEL is used to associate accelerator key entries with a Window.'!
!ACCEL class methodsFor!
defineFields
"Define the Win32 ACCEL structure
ACCEL compileDefinition
typedef struct tagACCEL
{
BYTE fVirt;
WORD key;
WORD cmd;
} ACCEL;
"
self
defineField: #fVirt type: BYTEField new beWriteOnly;
defineField: #key type: WORDField new beWriteOnly;
defineField: #cmd type: WORDField new beWriteOnly! !
!ACCEL methodsFor!
cmd: anObject
"Set the receiver's cmd field to the value of anObject.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated."
bytes wordAtOffset: 4 put: anObject!
fVirt: anObject
"Set the receiver's fVirt field to the value of anObject.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated."
bytes byteAtOffset: 0 put: anObject!
key: anObject
"Set the receiver's key field to the value of anObject.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated"
bytes wordAtOffset: 2 put: anObject! !
BITMAP comment:
'BITMAP is an <ExternalStructure> class to represent the Win32 structure of the same name.
The BITMAP structure is used to describe bitmaps, containing attributes such as the width, height, and color format, and a pointer to the bitmap''s bits.'!
'CCHITTESTINFO is an ExternalStructure class which implements shared behaviour and state for the common controls hit-test structures, LVHITTESTINFO, TCHITTESTINFO, and TVHITTESTINFO. There is no actual Win32 common control structure of this name.'!
!CCHITTESTINFO class methodsFor!
defineFields
"Define the common fields of the common control hit test structures.
"Answer the receiver's flags field as a Smalltalk object.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated."
^(bytes dwordAtOffset: 8)!
handle
"Private - Answer the item 'handle' associated with the receiver."
^self subclassResponsibility!
isItemHit
"Answer whether the receiver represents a hit on an item in a list view."
^self handle notNull!
pt: anObject
"Set the receiver's pt field to the value of anObject.
This method has been automatically generated from the class' structure template.
Any modifications you make will be lost the next time it is so generated."
anObject replaceBytesOf: bytes from: 1 to: 8 startingAt: 1! !
CCITEM comment:
'CCITEM is an <ExternalStructure> class which implements shared behaviour and state for the common controls item structures, LVITEM, TCITEM and TVITEM. There is no actual Win32 common control structure of this name.'!
!CCITEM methodsFor!
cchTextMax
"Answer the receiver's cchTextMax field as a Smalltalk object."
^self subclassResponsibility!
dwState
"Answer the receiver's dwState field as a Smalltalk object."
^self subclassResponsibility!
dwState: anObject
"Set the receiver's dwState field to the value of anObject."
^self subclassResponsibility!
handle
"Answer the 'handle' of the item described by the receiver."
^self subclassResponsibility!
iImage: anObject
"Set the receiver's iImage field to the value of anObject."
^self subclassResponsibility!
image: anInteger
"Set contents' iImage member to anInteger"
self iImage: anInteger.
self maskIn: self imageValidMask!
imageCallback
"Sets the receiver into image callback mode"
self image: I_IMAGECALLBACK!
imageValidMask
"Private - Answer the bit mask the receiver uses to denote that the iImage
field has valid contents."
^self subclassResponsibility!
lParam: anObject
"Set the receiver's lParam field to the value of anObject."
^self subclassResponsibility!
mask
"Answer the receiver's mask field as a Smalltalk object."
^self subclassResponsibility!
mask: anInteger
"Set the receiver's mask field to the value of anObject."
^self subclassResponsibility!
maskIn: anInteger
"OR in to contents' mask member the bit flags represented by anInteger"
self mask: (self mask bitOr: anInteger)!
param: anId
"Set contents's lParam member to anIs marking the modifications in the mask."
self lParam: anId.
self maskIn: self paramValidMask!
paramValidMask
"Private - Answer the bit mask the receiver uses to denote that the pszText
field has valid contents."
^self subclassResponsibility!
pszText: anObject
"Set the receiver's pszText field to the value of anObject."
^self subclassResponsibility!
pszTextAddress
"Private - Answer the address of the text buffer. "
^bytes sdwordAtOffset: self textPointerOffset!
state: anInteger
"Set contents' state member from anInteger"
self dwState: anInteger;
maskIn: self stateValidMask;
stateMask: anInteger!
stateMask: anObject
"Set the receiver's stateMask field to the value of anObject."
^self subclassResponsibility!
stateMaskIn: anInteger
"Private - OR in to contents' state member the bit flags represented by anInteger"
self state: (self dwState bitOr: anInteger)!
stateMaskOut: anInteger
"Private - Mask out of contents' state member the bit flags represented by anInteger"
self state: (self dwState maskClear: anInteger)!
stateValidMask
"Private - Answer the bit mask the receiver uses to denote that the dwState
field has valid contents."
^self subclassResponsibility!
text
"Answer the text of the receiver"
^text!
text: aString
"Sets contents' pszMember to aString. We also hang on to it in our
text instance var to ensure that its lifetime is sufficiently long
"Append a textual representation of the receiver to aStream, suitable for an end user.
Note that we always display in local time rather than UTC, and of course the receiver
is already in local time."
aStream display: self asSYSTEMTIME
!
integerValue: anInteger
"Set the number of 100-nanosecond intervals the receiver represents since the
FILETIME epoch."
bytes qwordAtOffset: 0 put: anInteger!
printOn: aStream
"Append a debug representation of the receiver to aStream."
aStream
basicPrint: self;
nextPut: $(;
display: self;
nextPut: $)
! !
FINDREPLACE comment:
'FINDREPLACE is a <Win32lStructure> which represents the Windows common dialog structure of the same name. It is used in conjunction with the FindText() and ReplaceText() APIs to to contain information about a search or replace operation.
'!
!FINDREPLACE class methodsFor!
defineFields
"Define the fields of the Win32 FINDREPLACE structure.
"Answer the extent of the icon descibed by the receiver in pels.
Implementation Note: This is determined from the extent of the foreground bitmap.
In order to avoid a dependency on bitmap (Icons are always used in Dolphin
applications, but bitmaps might not be) we open code access to the bitmaps
extent."
| bitmapInfo |
bitmapInfo := BITMAP new.
GDILibrary default
getObject: self hbmColor
cbBuffer: bitmapInfo byteSize
lpvObject: bitmapInfo.
^bitmapInfo extent!
free
"Free any external resources owner by the receiver."
| hbm |
self beUnfinalizable.
hbm := self hbmColor.
hbm isNull ifFalse: [
GDILibrary default deleteObject: hbm.
self hbmColor: 0].
hbm := self hbmMask.
hbm isNull ifFalse: [
GDILibrary default deleteObject: hbm.
self hbmMask: 0].
!
hbmColor
"Answer the receiver's hbmColor field as a Smalltalk object.
Automatically generated get method - do not modify"
^(bytes dwordAtOffset: 16)!
hbmColor: anObject
"Set the receiver's hbmColor field to the value of anObject.
Automatically generated set method - do not modify"
bytes dwordAtOffset: 16 put: anObject!
hbmMask
"Answer the receiver's hbmMask field as a Smalltalk object.
Automatically generated get method - do not modify"
^(bytes dwordAtOffset: 12)!
hbmMask: anObject
"Set the receiver's hbmMask field to the value of anObject.
Automatically generated set method - do not modify"
bytes dwordAtOffset: 12 put: anObject!
initialize
"Private - Initialize the receiver.
Mark as finalizable because the GetIconInfo() function creates bitmaps in order to return
the handles!!"
self beFinalizable!
xHotspot
"Answer the receiver's xHotspot field as a Smalltalk object.
Automatically generated get method - do not modify"
^(bytes dwordAtOffset: 4)!
yHotspot
"Answer the receiver's yHotspot field as a Smalltalk object.
Automatically generated get method - do not modify"
^(bytes dwordAtOffset: 8)! !
ITEMIDLIST comment:
'<ITEMIDLIST> is an <ExternalStructure> class to wrap the struct ''Win.ITEMIDLIST'' from type information in the ''Windows API (ANSI)'' library.
The type library contains no documentation for this struct.
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.
"Set the receiver's uCallbackMessage field to the value of anObject."
bytes dwordAtOffset: 16 put: anObject!
uFlags
"Answer the receiver's uFlags field as a Smalltalk object."
^(bytes dwordAtOffset: 12)!
uFlags: anObject
"Set the receiver's uFlags field to the value of anObject."
bytes dwordAtOffset: 12 put: anObject!
uID: anObject
"Set the receiver's uID field to the value of anObject."
bytes dwordAtOffset: 8 put: anObject! !
OPENFILENAME comment:
'OPENFILENAME is a <Win32Structure> which represent the Windows Common Dialog structure of the same name. It is used in conjunction with the GetOpenFileName() and GetSaveFileName() APIs which pop a common file dialog to browser for a file to load or save respectively. See the <FileDialog> and the Win32 documentation for further details.
The following instance variables hold <String> objects whose addresses have been stored into the structure. This is necessary to prevent premature garbage collection of these objects occurring during an external API call.
Instance Variables:
fileName <String>
title <String>
filter <String>
defExt <String>
fileTitle <String>
initialDir <String>'!
!OPENFILENAME class methodsFor!
defineFields
"Define the fields of the Win32 OPENFILENAME structure.
"Answer the receiver's fErase field as a Smalltalk object."
^(bytes dwordAtOffset: 4) asBoolean!
rcPaint
"Answer the receiver's rcPaint field as a Smalltalk object."
^RECT fromAddress: (bytes yourAddress + 8)! !
PALETTEENTRY comment:
'<PALETTEENTRY> is an <ExternalStructure> class to wrap the struct ''OCIDL.PALETTEENTRY'' from type information in the ''OCIDL Library'' library.
The type library contains no documentation for this struct
WARNING: This comment was automatically generated from the struct''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!PALETTEENTRY class methodsFor!
defineFields
"Define the fields of the PALETTEENTRY structure.
PALETTEENTRY compileDefinition
typedef struct tagPALETTEENTRY {
BYTE peRed;
BYTE peGreen;
BYTE peBlue;
BYTE peFlags;
} PALETTEENTRY;
"
self
defineField: #peRed type: BYTEField new offset: 0;
defineField: #peGreen type: BYTEField new offset: 1;
defineField: #peBlue type: BYTEField new offset: 2;
defineField: #peFlags type: BYTEField new beUncompiled offset: 3.
self byteSize: 4!
threeThreeTwo
"Answer a packed array palette entries to specify a default 332 palette."
"Answer the receiver's wAlignment field as a Smalltalk object."
^(bytes wordAtOffset: 24)!
wAlignment: anObject
"Set the receiver's wAlignment field to the value of anObject."
bytes wordAtOffset: 24 put: anObject!
wNumbering
"Answer the receiver's wNumbering field as a Smalltalk object."
^(bytes wordAtOffset: 8)!
wNumbering: anObject
"Set the receiver's wNumbering field to the value of anObject."
bytes wordAtOffset: 8 put: anObject! !
POINTL comment:
'<POINTL> is an <ExternalStructure> class to wrap the struct ''OCIDL.POINTL'' from type information in the ''OCIDL Library'' library.
The type library contains no documentation for this struct
WARNING: This comment was automatically generated from the struct''s type information and any changes made here may be overwritten the next time this wrapper class is so generated.'!
!POINTL class methodsFor!
defineFields
"Define the fields of the Win32 POINTL structure.
POINTL compileDefinition
"
self
defineField: #x type: SDWORDField new;
defineField: #y type: SDWORDField new!
fromPoint: aPoint
"Answer a new instance of the receiver representing aPoint."
^self x: aPoint x y: aPoint y!
icon
"Answer a suitable iconic representation for the receiver."
^Point icon!
initialize
"Private - Initialize the receiver.
Many typelibs refer to POINT, so it helps to alias that."
self environment at: #POINT put: self!
uninitialize
"Private - Unitialize the receiver as it is about to be removed from the system.
Make sure our alias disappears with us."
self environment removeKey: #POINT ifAbsent: []!
x: x y: y
"Answer a new instance of the receiver representing the Point whose
cartesian coordinates are the arguments.
Implementation Note: For performance reasons avoid going through
all the <ExternalStructure> framework methods."
^self basicNew
bytes: ((ByteArray newFixed: 8)
sdwordAtOffset: 0 put: x;
sdwordAtOffset: 4 put: y;
yourself)
! !
!POINTL methodsFor!
asDword
"Answer the receiver in a form suitable for passing or returning
as a 32-bit value (i.e. a 32-bit integer)."
^(DWORD fromPoint: self) asDword!
asObject
"Answer a suitable Smalltalk object to represent the receiver's value, in this case
a <Point>."
^self asPoint!
asPoint
"Answer a Point created that matches the receiver"
^self x @ self y!
printOn: aStream
"Append a short textual description of the receiver to aStream."
aStream
basicPrint: self;
nextPut: $(; print: self asPoint; nextPut: $)!
x
"Answer the receiver's x field as a Smalltalk object."
^(bytes sdwordAtOffset: 0)!
x: anObject
"Set the receiver's x field to the value of anObject."
bytes sdwordAtOffset: 0 put: anObject!
y
"Answer the receiver's y field as a Smalltalk object."
^(bytes sdwordAtOffset: 4)!
y: anObject
"Set the receiver's y field to the value of anObject."
bytes sdwordAtOffset: 4 put: anObject! !
PRINTDLG comment:
''!
!PRINTDLG class methodsFor!
defineFields
"Define the fields of the Win32 PRINTDLG structure.
'<RECT> is an <ExternalStructure> class to wrap the standard Win32 structure of the same name.
The RECT structure is used in many places to represent a rectangle consisting of 32 bit co-ordinates for top-left and bottom-right corners. <RECTL> is an alias for the same class/structure.'!
!RECT class methodsFor!
defineFields
"Define the fields of the RECT structure.
RECT compileDefinition
typedef struct tagRECT {
long left;
long top;
long right;
long bottom;
} RECT;
"
self
defineField: #left type: SDWORDField new offset: 0;
defineField: #top type: SDWORDField new offset: 4;
defineField: #right type: SDWORDField new offset: 8;
defineField: #bottom type: SDWORDField new offset: 12.
self byteSize: 16!
fromRectangle: aRectangle
"Answer a new instance of the receiver instantiated from the Smalltalk
Rectangle, aRectangle."
^self
left: aRectangle left
top: aRectangle top
right: aRectangle right
bottom: aRectangle bottom
!
icon
"Answer a suitable iconic representation for the receiver."
^Rectangle icon!
initialize
"Private - Initialize the receiver.
Many typelibs refer to RECTL, so it helps to alias that.
self initialize
"
self environment at: #RECTL put: self!
left: left top: top right: right bottom: bottom
"Answer a new instance of the receiver with the specified position
corner positions.
Implementation Note: For performance reasons do this all with low-level
inline code."
^self basicNew
bytes: ((ByteArray newFixed: 16)
sdwordAtOffset: 0 put: left;
sdwordAtOffset: 4 put: top;
sdwordAtOffset: 8 put: right;
sdwordAtOffset: 12 put: bottom;
yourself)!
left: left top: top width: width height: height
"Answer a new instance of the receiver with the specified position
and dimensions."
^self
left: left
top: top
right: left+width
bottom: top+height
!
uninitialize
"Private - Unitialize the receiver as it is about to be removed from the system.
"Set the receiver's dwSize field to the value of anObject."
bytes dwordAtOffset: 0 put: anObject! !
SHITEMID comment:
'<SHITEMID> is an <ExternalStructure> class to wrap the struct ''IShellFolderEx.SHITEMID'' from type information in the ''IShellFolder Extended Type Library v1.0'' library.
The type library contains no documentation for this struct.
Warning: This comment was automatically generated from the struct''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.
'<SIZE> is an <ExternalStructure> class to wrap the standard Win32 structure of the same name. SIZE is used in many places to represent a 2-dimensional distance where the x and y dimensions are expressed as 32-bit integers. SIZEL is an alias for the same class/structure.'!
!SIZE class methodsFor!
defineFields
"Define the fields of the SIZEL structure.
SIZEL compileDefinition
typedef struct tagSIZEL {
long cx;
long cy;
} SIZEL;
"
self
defineField: #cx type: SDWORDField new offset: 0;
defineField: #cy type: SDWORDField new offset: 4.
self byteSize: 8!
icon
"Answer a suitable iconic representation for the receiver."
^Icon fromId: 'extent.ico'!
initialize
"Private - Initialize the receiver.
Many typelibs refer to SIZEL, so it helps to alias that."
self environment at: #SIZEL put: self!
uninitialize
"Private - Unitialize the receiver as it is about to be removed from the system.
"Answer the receiver's tmAscent field as a Smalltalk object."
^(bytes sdwordAtOffset: 4)!
tmAveCharWidth
"Answer the receiver's tmAveCharWidth field as a Smalltalk object."
^(bytes sdwordAtOffset: 20)!
tmBreakChar
"Answer the receiver's tmBreakChar field as a Smalltalk object."
^(bytes byteAtOffset: 47)!
tmCharSet
"Answer the receiver's tmCharSet field as a Smalltalk object."
^(bytes byteAtOffset: 52)!
tmDefaultChar
"Answer the receiver's tmDefaultChar field as a Smalltalk object."
^(bytes byteAtOffset: 46)!
tmDescent
"Answer the receiver's tmDescent field as a Smalltalk object."
^(bytes sdwordAtOffset: 8)!
tmDigitizedAspectX
"Answer the receiver's tmDigitizedAspectX field as a Smalltalk object."
^(bytes sdwordAtOffset: 36)!
tmDigitizedAspectY
"Answer the receiver's tmDigitizedAspectY field as a Smalltalk object."
^(bytes sdwordAtOffset: 40)!
tmExternalLeading
"Answer the receiver's tmExternalLeading field as a Smalltalk object."
^(bytes sdwordAtOffset: 16)!
tmFirstChar
"Answer the receiver's tmFirstChar field as a Smalltalk object."
^(bytes byteAtOffset: 44)!
tmHeight
"Answer the receiver's tmHeight field as a Smalltalk object."
^(bytes sdwordAtOffset: 0)!
tmInternalLeading
"Answer the receiver's tmInternalLeading field as a Smalltalk object."
^(bytes sdwordAtOffset: 12)!
tmItalic
"Answer the receiver's tmItalic field as a Smalltalk object."
^(bytes byteAtOffset: 48)!
tmLastChar
"Answer the receiver's tmLastChar field as a Smalltalk object."
^(bytes byteAtOffset: 45)!
tmMaxCharWidth
"Answer the receiver's tmMaxCharWidth field as a Smalltalk object."
^(bytes sdwordAtOffset: 24)!
tmOverhang
"Answer the receiver's tmOverhang field as a Smalltalk object."
^(bytes sdwordAtOffset: 32)!
tmPitchAndFamily
"Answer the receiver's tmPitchAndFamily field as a Smalltalk object."
^(bytes byteAtOffset: 51)!
tmStruckOut
"Answer the receiver's tmStruckOut field as a Smalltalk object."
^(bytes byteAtOffset: 50)!
tmUnderlined
"Answer the receiver's tmUnderlined field as a Smalltalk object."
^(bytes byteAtOffset: 49)!
tmWeight
"Answer the receiver's tmWeight field as a Smalltalk object."
^(bytes sdwordAtOffset: 28)! !
TEXTRANGE comment:
'TEXTRANGE is the class of <ExternalStructure> which represent the Windows RichEdit control structure of the same name.
TEXTRANGE is used in conjunction with the EM_GETTEXTRANGE message to specify the range of text to retrieve from a Rich Edit control and to provide a buffer to copy the text into.
We also use this structure where a FINDTEXT is needed because it has exactly the same layout. The FINDTEXT structure is used in conjunction with the EM_FINDTEXT message to contain information about a search operation in a Rich Edit control.
Instance Variables:
text <String>. Buffer whose address is stored into structure (to prevent premature GC).'!
!TEXTRANGE class methodsFor!
defineFields
"Define the fields of the Win32 TEXTRANGE structure.
defineField: #item type: (StructureField type: TVITEM) "read/write so can get pointer to embedded TV_ITEM"
! !
!TVINSERTSTRUCT methodsFor!
hInsertAfter: anObject
"Set the receiver's hInsertAfter field to the value of anObject.
Automatically generated set method - do not modify"
bytes dwordAtOffset: 4 put: anObject!
hParent: anObject
"Set the receiver's hParent field to the value of anObject.
Automatically generated set method - do not modify"
bytes dwordAtOffset: 0 put: anObject!
item
"Answer the receiver's item field as a Smalltalk object.
Automatically generated get method - do not modify"
^TVITEM fromAddress: (bytes yourAddress + 8)!
item: anObject
"Set the receiver's item field to the value of anObject.
Automatically generated set method - do not modify"
anObject replaceBytesOf: bytes from: 9 to: 48 startingAt: 1! !
VS_FIXEDFILEINFO comment:
'VS_FIXEDFILEINFO is an ExternalStructure class to represent the Win32 structure of the same name.
This structure is used in conjunction with the Windows version information library (Version.DLL) to access standard version information such as the product major and minor version numbers from the resources of exes and dlls.
See also the VersionInfo and VersionLibrary classes.'!
!VS_FIXEDFILEINFO class methodsFor!
defineFields
"Private - Define the layout of the Win32 VS_FIXEDFILEINFO structure.
'WIN32_FIND_DATA is an <ExternalStructure> to wrap the Win32 structure of the same name. WIN32_FIND_DATA is used in conjunction with the kernel library API functions FindFirstFile() and FindNextFile().
See File class for example usage.'!
!WIN32_FIND_DATA class methodsFor!
defineFields
"Define the layout of the Win32 WIN32_FIND_DATA structure.
Currently to avoid wasting space, the structure is defined as mostly filler
"Answer the receiver's cx field as a Smalltalk object."
^(bytes sdwordAtOffset: 16)!
cx: anObject
"Set the receiver's cx field to the value of anObject."
bytes sdwordAtOffset: 16 put: anObject!
cy
"Answer the receiver's cy field as a Smalltalk object."
^(bytes sdwordAtOffset: 20)!
cy: anObject
"Set the receiver's cy field to the value of anObject."
bytes sdwordAtOffset: 20 put: anObject!
flags
"Answer the receiver's flags field as a Smalltalk object."
^(bytes dwordAtOffset: 24)!
hwndInsertAfter
"Answer the receiver's hwndInsertAfter field as a Smalltalk object."
^(bytes dwordAtOffset: 4)!
x
"Answer the receiver's x field as a Smalltalk object."
^(bytes sdwordAtOffset: 8)!
y
"Answer the receiver's y field as a Smalltalk object."
^(bytes sdwordAtOffset: 12)! !
WNDCLASS comment:
'WNDCLASS is the class of <ExternalStructure> which represent the Windows structure of the same name. It is used to retrieve and specify Windows "Class" information, e.g. when registering a window class.
'!
!WNDCLASS class methodsFor!
defineFields
"Define the layout of the Win32 WNDCLASS structure. Currently to avoid
wasting space, the structure is set up for registering classes only
(i.e. the fields are fillers or write only). Furthermore it is not
"Private - Set the flag in the receiver's mask which informs the TreeView to save
any details included in this item and not ask for them again."
self maskIn: TVIF_DI_SETITEM!
selectedImage: anInteger
"Set contents' iSelectedImage member to anInteger"
self iSelectedImage: anInteger.
self maskIn: TVIF_SELECTEDIMAGE!
stateMask
"Answer the receiver's stateMask field as a Smalltalk object."
^(bytes dwordAtOffset: 12)!
stateMask: anObject
"Set the receiver's stateMask field to the value of anObject."
bytes dwordAtOffset: 12 put: anObject!
stateValidMask
"Private - Answer the bit mask the receiver uses to denote that the dwState
field has valid contents."
^TVIF_STATE!
textPointerOffset
"Private - Answer the offset of the text pointer in the receiver. "
^16!
textValidMask
"Private - Answer the bit mask the receiver uses to denote that the pszText
field has valid contents."
^TVIF_TEXT! !
LocalFILETIME comment:
'LocalFILETIME is an ExternalStructure class to represent the Win32 FILETIMEs that are in local time, as opposed to the usual UTC of normal FILETIMEs. See <FILETIME> for further details.'!
!LocalFILETIME class methodsFor!
fromSYSTEMTIME: aSYSTEMTIME
"Answer a file time from the specified SYSTEMTIME (assumed to be in
"Private - Update the details for a normal menu item (i.e. the text, type flags, and state).
This message is used when dynamically updating menu items."
| mask |
mask := aStringOrNil isNil
ifTrue: [##(MIIM_FTYPE | MIIM_STATE)]
ifFalse:
[self basicText: aStringOrNil.
##(MIIM_FTYPE | MIIM_STATE | MIIM_STRING)].
aMenuItem bitmap ifNotNil:
[:bitmap |
mask := mask bitOr: MIIM_BITMAP.
self hbmpItem: bitmap asParameter].
self
fType: aMenuItem styleFlags;
fState: aString;
fMask: mask!
subMenu: aMenuOrHandle text: aString
"Private - Set menu insertion details for a Sub-menu."
self
basicText: aString;
hSubMenu: aMenuOrHandle asParameter;
fMask: ##(MIIM_SUBMENU|MIIM_STRING)!
type: anInteger
"Private - Set the fType field only. Used when creating menu items."
self
fType: anInteger;
fMask: MIIM_FTYPE!
type: flagsInteger text: aString id: idInteger
"Private - Set insertion details for a normal menu item (i.e. the text, type flags, and id)."
self
fType: flagsInteger;
basicText: aString;
wID: idInteger;
fMask: ##(MIIM_FTYPE | MIIM_STRING | MIIM_ID)! !
NMCUSTOMDRAW comment:
'NMCUSTOMDRAW is an <ExternalStructure> class to represent the Win32 structure of the same name.
NMCUSTOMDRAW structures are sent as parameter blocks along with certain WM_NOTIFY messages from Windows common controls such as the <ListView> and <TreeView> to request custom draw information for individual items (and optionally sub-items).
All the fields in this structure are read-only. Specialized sub-structures provide fields which can be written to in order to pass custom draw settings back to the control (for example the foreground and background text colours). The DC associated with this structure can also be updated by changing the font, and so forth.
'!
!NMCUSTOMDRAW class methodsFor!
defineFields
"Define the structure template for Win32 NMCUSTOMDRAW structure.
"Answer the receiver's iItem field as a Smalltalk object."
^(bytes sdwordAtOffset: 12)!
iSubItem
"Answer the receiver's iSubItem field as a Smalltalk object."
^(bytes sdwordAtOffset: 16)!
ptAction
"Answer the receiver's ptAction field as a Smalltalk object."
^POINTL fromAddress: (bytes yourAddress + 32)!
uChanged
"Answer the receiver's uChanged field as a Smalltalk object."
^(bytes dwordAtOffset: 28)!
uKeyFlags
"Answer the receiver's uKeyFlags field as a Smalltalk object."
^(bytes dwordAtOffset: 44)!
uNewState
"Answer the receiver's uNewState field as a Smalltalk object."
^(bytes dwordAtOffset: 20)!
uOldState
"Answer the receiver's uOldState field as a Smalltalk object."
^(bytes dwordAtOffset: 24)! !
NMKEYDOWN comment:
'NMKEYDOWN is an ExternalStructure class to represent the Win32 structures NMTVKEYDOWN, NMTCKEYDOWN and NMLVKEYDOWN, all of which have the same fields.
'!
!NMKEYDOWN class methodsFor!
defineFields
"Define the fields of the Win32 NMKEYDOWN structure
"Answer the receiver's dwHitInfo field as a Smalltalk object."
^(bytes dwordAtOffset: 28)!
dwItemData
"Answer the receiver's dwItemData field as a Smalltalk object."
^(bytes dwordAtOffset: 16)!
dwItemSpec
"Answer the receiver's dwItemSpec field as a Smalltalk object."
^(bytes dwordAtOffset: 12)!
iItem
"Answer the item index (appropriate when originating from a control whose items
are externally identified by integer keys)."
^bytes sdwordAtOffset: 12!
pt
"Answer the receiver's pt field as a Smalltalk object."
^POINTL fromAddress: (bytes yourAddress + 20)! !
NMTOOLBAR comment:
'NMTOOLBAR is the class of <ExternalStructure> which represent the Windows Common Control structure of the same name.
NMTOOLBAR accompanies certain notifications that are sent by a Toolbar control to its parent, e.g. when a drop-down button is pressed, such as the browser history list buttons (TBN_DROPDOWN). See the Win32 documentation for further details.
'!
!NMTOOLBAR class methodsFor!
defineFields
"Define the structure template for Win32 NMTOOLBAR structure.
'TOOLTIPTEXTA is the class of <ExternalStructure> which represent the Windows Common Control structure of the same name.
TOOLTIPTEXTA accompanies TTN_NEEDTEXTA notifications that are sent by a Toolbar control to its parent when it wishes to determine the ANSI (single-byte character) tool-tip text to be displayed for a toolbar button which the user is hovering over. See the Win32 documentation for further details.'!
!TOOLTIPTEXTA class methodsFor!
defineFields
"Define the structure template for Win32 TOOLTIPTEXTA structure.
"Private - Set the receiver's tip text to aN ANSI version of the argument, aString,
and answer that.
N.B. The answer must be referenced until the TOOLTIPTEXT is no longer required to
prevent it being prematurely GC'd."
| ansi |
ansi := aString asString.
self lpszText: ansi.
^ansi!
uFlags
"Answer the receiver's uFlags field as a Smalltalk object."
^(bytes dwordAtOffset: 100)! !
TOOLTIPTEXTW comment:
'TOOLTIPTEXTW is the class of <ExternalStructure> which represent the Windows Common Control structure of the same name.
TOOLTIPTEXTW accompanies TTN_NEEDTEXTW notifications that are sent by a Toolbar control to its parent when it wishes to determine the Unicode (double-byte character) tool-tip text to be displayed for a toolbar button which the user is hovering over. See the Win32 documentation for further details.'!
!TOOLTIPTEXTW class methodsFor!
defineFields
"Define the structure template for Win32 TOOLTIPTEXTW structure.
"Private - Set the receiver's tip text to a Unicode version of the argument, aString,
and answer that
N.B. The answer must be referenced until the TOOLTIPTEXT is no longer required to
prevent it being prematurely GC'd."
| unicode |
unicode := aString asUnicodeString.
self lpszText: unicode.
^unicode!
uFlags
"Answer the receiver's uFlags field as a Smalltalk object."
^(bytes dwordAtOffset: 180)! !
NMLVCUSTOMDRAW comment:
'NMLVCUSTOMDRAW is an <ExternalStructure> class to represent the Win32 structure of the same name.
NMLVCUSTOMDRAW is sent by <ListView> controls to request custom draw information for the text of individual items (and optionally sub-items). We implement the <customDrawContext> protocol against it in order that it can be passed directly to the views customDrawBlock.'!
!NMLVCUSTOMDRAW class methodsFor!
defineFields
"Define the structure template for Win32 NMLVCUSTOMDRAW structure.
Implementation Note: We must convert to an RGB because a COLORREF is needed."
self clrTextBk: aColor asColorRef asParameter!
clrText
"Answer the receiver's clrText field as a Smalltalk object."
^(bytes dwordAtOffset: 48)!
clrText: anObject
"Set the receiver's clrText field to the value of anObject."
bytes dwordAtOffset: 48 put: anObject!
clrTextBk
"Answer the receiver's clrTextBk field as a Smalltalk object."
^(bytes dwordAtOffset: 52)!
clrTextBk: anObject
"Set the receiver's clrTextBk field to the value of anObject."
bytes dwordAtOffset: 52 put: anObject!
column
"Answer the <ListViewColumn> associated with the sub-item if this is a sub-item
draw, otherwise nil."
^column!
column: aListViewColumn
"Private -"
column := aListViewColumn!
forecolor
"Answer the foreground text colour."
^ColorRef fromInteger: self clrText!
forecolor: aColor
"Sets the text foreground <Color>."
self clrText: aColor asColorRef asParameter!
iSubItem
"Answer the receiver's iSubItem field as a Smalltalk object."
^(bytes sdwordAtOffset: 56)!
itemHandle
"Answer the 'handle' of the receiver's item."
^self dwItemSpec + 1! !
NMTVCUSTOMDRAW comment:
'NMTVCUSTOMDRAW is an <ExternalStructure> class to represent the Win32 structure of the same name.
NMTVCUSTOMDRAW is sent by <TreeView> controls to request custom draw information for the text of individual nodes. We implement the <customDrawContext> protocol against it in order that it can be passed directly to the views customDrawBlock.'!
!NMTVCUSTOMDRAW class methodsFor!
defineFields
"Define the structure template for Win32 NMTVCUSTOMDRAW structure.
"Private - Assist in the image stripping process by clearning down any
lazily initialized variables held by the receiver."
self uninitialize!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
Current := nil! !
!AbsoluteFileLocator methodsFor!
localFileSpecFor: aStringFilename
"Answer a filespec for aStringFilename, which is expected to be an absolute path already."
^aStringFilename
!
relativePathTo: aFilename
"Answer a minimal <readableString> relative path to the resource with the
specified <readableString> path, which the receiver can map back to a full
path via its #localFileSpecFor: method. In this case we need an absolute path."
^File fullPathOf: aFilename
!
stbSaveOn: anSTBOutFiler
"Save out a binary representation of the receiver to anSTBOutFiler."
anSTBOutFiler
saveObject: self
as: (STBSingletonProxy for: self class using: #current)! !
ClassLocator comment:
'A ClassLocator is used to find a class for an object being read from an external serialized stream (such as STB). The locator first tries to match an exsiting class already in the image and, if this fails, it is then used to indicate the location of an external binary class that may be loaded into the image. To do this, the locator holds the code base where the external BinaryPackage file resides and a key (usually the class name) that can be used to identify a particular class within the package. The standard ClassLocator is used when the binary package file can be found on a UNC file system. If the class is part of an applet and is to be located by a URL then a URLClassLocator should be used instead.
Instance Variables:
packageName <readableString> indicating the name of the package containing the required class.
codeBase <readableString> indicating the base directory from which a BinaryPackage should be loaded.
key <readableString> indicating the name of a class to load from the package.
Class Variables:
ImportedClasses <WeakLookupTable> holding the imported classes looked up by their full class keys.
DefaultFileLocator <ClassLocator> which is the default locator to use when loading external resource files.
ImportedClassesMutex <Mutex> to use when resolving imported classes.
Aliases <WeakLookupTable> mapping old class names to existing class.
'!
!ClassLocator class methodsFor!
addAlias: aSymbol forClass: aClass
"Record the symbolic name, aSymbol, as an alias for the class name, aClass.
This is useful where, for example, previously binary filed classes have been renamed, and one
does not wish to keep a global variable for that alias. It can be useful to have the global variable
as well to permit loading subclasses, but such globals may be removed by the image stripper, so
some mechanism is needed to maintain backwards compatibility with old binary files."
Aliases at: aSymbol asSymbol put: aClass!
binaryPackageExtension
"Answers the standard file extension String used for binary package files."
^'pak'!
codeBase: codeBaseString
"Answer an instance of the receiver with a codeBase of codeBaseString and nil key. Such an instance
"Answer the receiver's package name <readableString>."
^packageName!
packageName: aString
"Private - Set the receiver's package name to aString."
packageName := aString!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a developer
would want to see it."
super printOn: aStream.
aStream
nextPut: $(;
print: packageName;
nextPutAll: ', ';
print: codeBase;
nextPutAll: ', ';
print: key;
nextPut: $)! !
RelativeFileLocator comment:
'RelativeFileLocator is the abstract class of <FileLocator>s that can be used to map between an absolute path and a path relative to a certain base directory.
RelativeFileLocators use absolute paths for files outside the local directory hierarchy below the base directory, and relative paths within their local directory hierarchy.'!
!RelativeFileLocator methodsFor!
relativePathTo: aString
"Answer a minimal <readableString> relative path to the resource with the
specified <readableString> path from the receiver's base path."
^self relativePathIfSubPath: aString! !
ValidatingClassLocator comment:
'A ValidatingClassLocator is an extension to the standard ClassLocator which can be used to validate classes of objects being read from an external serial stream (such as STB). STB is inherently an insecure format since it can contain any objects, including blocks of code which may be malicious in nature. By plugging a ValidatingClassLocator into an STBInFiler then one is able to check the classes of objects in the input stream before they are allowed into the image.
The validation is controlled by a #validationBlock which is passed the symbolic class names of objects being loaded. The block should return true if the load is to be permitted. If the block returns false then an STBError exception is signalled.
Typically, ValidatingClassLocator can be considered a private class only instantiated as part of an STBValidatingInFiler.'!
!ValidatingClassLocator methodsFor!
copyWithCodeBase
"Private - Answer a instance of the same class as the receiver with the same codeBase.
This allows both the codeBase and the mechanism for using it to be propagated."
"Answer the monadic valuable (usually a block) that when passed a class name symbol will answer true if objects
of this class are valid for loading into the image from the input stream associated with the receiver."
^validationBlock!
validationBlock: aMonadicValuable
"Set the monadic valuable (usually a block) that when passed a class name symbol will answer true if objects
of this class are valid for loading into the image from the input stream associated with the receiver."
validationBlock := aMonadicValuable.
! !
FolderRelativeFileLocator comment:
'FolderRelativeFileLocator is the class of <FileLocator>s that can be used to map between an absolute path and a path relative to a configurable base directory.
FolderRelativeFileLocators use absolute paths for files outside the local directory hierarchy below the base directory, and relative paths within their local directory hierarchy.
Instance Variables:
basePath <String>. Base folder path.
'!
!FolderRelativeFileLocator class methodsFor!
basePath: aString
"Answer a new instance of the receiver for the specified base path."
^(self new)
basePath: aString;
yourself! !
!FolderRelativeFileLocator methodsFor!
basePath
^basePath!
basePath: aString
basePath := aString! !
ImageRelativeFileLocator comment:
'An ImageRelativeFileLocator is used to indicate the location of an external file that may be referenced within the image.
Instances of this class always locate files relative to the image directory, unless the file is outside the local directory hierarchy below the image directory, in which case an absolute path is used.
Note that the ''image'' directory may dynamically change between image restarts, and in the case of a deployed application the ''image'' directory is the folder in which the executable resides.
Try the following examples:
relativePath := FileLocator imageRelative relativePathTo: SessionManager current imageFileName. "Display It - should be ''.\dolphin.img''"
FileLocator imageRelative localFileSpecFor: relativePath. "Display It - should be the full image path"'!
!ImageRelativeFileLocator class methodsFor!
current
"Answer the singleton instance of the receiver"
Current isNil ifTrue: [ Current := self new ].
^Current!
onPreStripImage
"Private - Assist in the image stripping process by clearning down any
lazily initialized variables held by the receiver."
self uninitialize!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
Current := nil! !
!ImageRelativeFileLocator methodsFor!
stbSaveOn: anSTBOutFiler
"Save out a binary representation of the receiver to anSTBOutFiler."
anSTBOutFiler saveObject: self
as: (STBSingletonProxy for: self class using: #current)! !
InstallRelativeFileLocator comment:
'An ImageRelativeFileLocator is used to indicate the location of an external file that may be referenced within the image.
Instances of this class always locate files relative to the image directory, unless the file is outside the local directory hierarchy below the install directory, in which case an absolute path is used.
'!
!InstallRelativeFileLocator class methodsFor!
current
"Answer the singleton instance of the receiver"
Current isNil ifTrue: [ Current := self new ].
^Current!
onPreStripImage
"Private - Assist in the image stripping process by clearning down any
lazily initialized variables held by the receiver."
self uninitialize!
uninitialize
"Private - Uninitialize the receiver as it is about to be removed from the system."
Current := nil! !
!InstallRelativeFileLocator methodsFor!
basePath
^SessionManager current installationDirectory!
stbSaveOn: anSTBOutFiler
"Save out a binary representation of the receiver to anSTBOutFiler."
anSTBOutFiler
saveObject: self
as: (STBSingletonProxy for: self class using: #current)! !
PackageFolder comment:
''!
!PackageFolder class methodsFor!
dolphinRoot
"Answer an instance of the receiver representing the current dolphin package hierarchy"
^self pathname: self dolphinRootPathname!
dolphinRootPathname
^'Object Arts\Dolphin'!
forPackage: aPackage
"Answer an instance of the receiver for the folder of aPackage"
"Answer a new instance of the receiver representing the stock pen id anInteger."
^self new
ownsHandle: false;
id: anInteger;
yourself! !
!StockPen methodsFor!
createHandle
"Private - Answer the handle for the stock pen with receiver's id."
^self getStockObject: id!
id: anInteger
"Private - Set stockID to anInteger and obtain the handle."
id := anInteger.
self basicRealize! !
CLSID comment:
'CLSID the class of 128-bit Globally Unique Identifiers (guids) which are specifically used to uniquely identify coclasses (components) in COM.
The CLSIDs of all coclasses registered on your machine can be found under the HKCR\CLSID key in your registry. Each correctly formed entry will have a human (are VB programmers human?) readable form (a ProgID) directly under HKCR.'!
!CLSID class methodsFor!
fromProgID: aString
"Answer a new instance of the receiver instantiated from the argument, aString,
which contains a ProgID which is expected to be in the registry."
'IID is the class of 128-bit Globally Unique Identifiers (guids) which are specifically used to uniquely identify interfaces in COM.
Many interfaces are not recorded in the registry, but if they have marshalling support (a proxy/stub DLL) then they will be registered under HKCR\Interfaces. Registered IIDs will display with their registered name, otherwise the string representation of their GUID is printed.'!
!IID class methodsFor!
fromString: aString
"Answer a new instance of the receiver instantiated from the argument, aString,
'<CapturingInteractor> is the class of interactors that intercept user input events and absorb them so that they do not reach the presenter. i.e. if a <CapturingInteractor> is installed into a view then it will appear to ignore all user input. Subclasses may use the input for other purposes, or selectively forward it on to the presenter.'!
!CapturingInteractor methodsFor!
onKeyPressed: aKeyEvent
"The event source received a key press event, gobble it up."
^false!
onKeyReleased: aKeyEvent
"The event source received a key upevent, gobble it up."
^false!
onKeyTyped: aKeyEvent
"The event source received a key entry event, gobble it up.
Implementation Note: These should not actually occur since
key/up and down events are consumed and not passed on for
default processing."
^false!
onLeftButtonDoubleClicked: aMouseEvent
"The event source received a mouse left button double-click event
gobble it up."
^false!
onLeftButtonPressed: aMouseEvent
"The event source received a mouse left button down event,
gobble it up."
^false!
onLeftButtonReleased: aMouseEvent
"The event source received a mouse left button up event,
gobble it up."
^false!
onMiddleButtonDoubleClicked: aMouseEvent
"The event source received a mouse middle button double-click event
gobble it up."
^false!
onMiddleButtonPressed: aMouseEvent
"The event source received a mouse middle button down event,
gobble it up."
^false!
onMiddleButtonReleased: aMouseEvent
"The event source received a mouse middle button up event,
gobble it up."
^false!
onMouseMoved: aMouseEvent
"The event source received a mouse move event,
gobble it up."
^false!
onMouseWheeled: aMouseEvent
"The event source received a mouse wheel event,
gobble it up."
^false!
onRightButtonDoubleClicked: aMouseEvent
"The event source received a mouse right button double-click event,
gobble it up."
^false!
onRightButtonPressed: aMouseEvent
"The event source received a mouse right button down event,
gobble it up."
^false!
onRightButtonReleased: aMouseEvent
"The event source received a mouse right button up event,
gobble it up."
^false! !
MouseTracker comment:
'<MouseTracker> is an <Interactor> that is used to manage the visual dragging of objects using the mouse. An instance should be created as the result of a mouse down event and once started using #startTracking: it captures the mouse and relays the drag messages that are part of the <mouseTrackerTarget> protocol to the target that is assigned to it. Once the drag has completed, and the originating button has been released, the mouse capture is also dropped. Tracking will also be cancelled if the user Alt+Tab''s to another application, or presses the ESC (escape) key (assuming the originating view still has focus).
Instance Variables:
dragButton <Symbol> identifying the button (either #left or #right) that started the drag
target <mouseTrackerTarget> that receives tracking messages.
startPoint <Point> at which the drag started.
origin <Point> which identifies the origin of an object being dragged.
hysteresis <Point> extent of rectangle outside of which the mouse must move before a drag is started.
isTracking <boolean> indicating whether a drag has actually started.
trackPosition <Point> holding the last drag position.
constrain <Symbol> or nil, identifying any drag constraint (either #horizontal or #vertical).
'!
!MouseTracker class methodsFor!
defaultHysteresis
"Answer the default distance in pixels that the mouse must move before
"Private - Set the latest tracking position of the target based on
a delta value from the origin"
trackPosition := self origin + aPointDelta! !
BorderLayout comment:
'BorderLayout implements a general purpose <layoutManager> to layout <view> objects within a <compositeView>. It arranges views that have been added to their parent container with the #arrangement aspects #north, #south, #east, #west and #center. These identified views are arranged along the appropriate edges and in the centre of the container. A BorderLayout attempts to keep the radial dimension of the edge components fixed at either their current size or (if specified) the preferred size.
Instance Variables:
hgap <integer> horizontal gap between adjacent views
vgap <integer> verticall gap between adjacent views
north <view> that will be positioned at the top of the container
south <view> that will be positioned at the bottom of the container
east <view> that will be positioned at the right of the container
west <view> that will be positioned at the left of the container
center <view> that will be positioned at the centre of the container
'!
!BorderLayout class methodsFor!
horizontalGap: horizontal verticalGap: vertical
"Answer a new instance of the receiver intialized with
the supplied gaps."
^self new
horizontalGap: horizontal;
verticalGap: vertical;
yourself!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect integer: #horizontalGap);
add: (Aspect integer: #verticalGap);
yourself! !
!BorderLayout methodsFor!
arrangementAspect
"Private - Answer an Aspect description for the arrangement aspect of Views that
are managed by the receiver."
^Aspect choice: #arrangement from: #(north south east west center) andNil: #none
!
arrangementOf: aView
"Answer the arrangement parameter of aView in the receiver.
This will be one of #center, #east, #west, #north, #south
or nil if no paramter has been set for aView"
self center == aView ifTrue: [ ^#center ].
self west == aView ifTrue: [ ^#west ].
self east == aView ifTrue: [ ^#east ].
self north == aView ifTrue: [ ^#north ].
self south == aView ifTrue: [ ^#south ].
^nil
!
arrangementOf: aView put: arrange
"Set the arrangement parameter of aView in the receiver to be anObject"
right := aContainerView clientWidth - insets right.
self hasNorth
ifTrue:
[| d |
self north extent: (right - left) @ self north height.
d := self north layoutExtent.
self north rectangle: (left @ top extent: (right - left) @ d y).
top := top + d y + self verticalGap].
self hasSouth
ifTrue:
[| d |
self south extent: (right - left) @ self south height.
d := self south layoutExtent.
self south rectangle: (left @ (bottom - d y) extent: (right - left) @ d y).
bottom := bottom - (d y + self verticalGap)].
self hasEast
ifTrue:
[| d |
self east extent: self east width @ (bottom - top).
d := self east layoutExtent.
self east rectangle: ((right - d x) @ top extent: d x @ (bottom - top)).
right := right - (d x + self horizontalGap)].
self hasWest
ifTrue:
[| d |
self west extent: self west width @ (bottom - top).
d := self west layoutExtent.
self west rectangle: (left @ top extent: d x @ (bottom - top)).
left := left + d x + self horizontalGap].
self hasCenter
ifTrue: [self center rectangle: (left @ top extent: (right - left) @ (bottom - top))]!
north
"Answer the view arranged to the top edge of the container
view for which the receiver lays out subviews."
^north!
north: aView
"Set the view arranged to the top edge of the container
view for which the receiver lays out subviews."
north := aView!
preferredLayoutExtentOf: aContainerView
"Answer aPoint which is the preferred extent when laying out aContainerView"
| dim insets |
dim := 0 @ 0.
self hasEast
ifTrue:
[| d |
d := self east layoutExtent.
dim x: dim x + d x + self horizontalGap.
dim y: (d y max: dim y)].
self hasWest
ifTrue:
[| d |
d := self west layoutExtent.
dim x: dim x + d x + self horizontalGap.
dim y: (d y max: dim y)].
self hasCenter
ifTrue:
[| d |
d := self center layoutExtent.
dim x: dim x + d x.
dim y: (d y max: dim y)].
self hasNorth
ifTrue:
[| d |
d := self north layoutExtent.
dim x: (d x max: dim x).
dim y: dim y + d y + self verticalGap].
self hasSouth
ifTrue:
[| d |
d := self south layoutExtent.
dim x: (d x max: dim x).
dim y: dim y + d y + self verticalGap].
insets := aContainerView actualInsets.
^dim + insets topLeft + insets bottomRight!
removeSubView: aView
"Remove aView from the collection of views which have been explicitly
arranged by the receiver.
Answer aView."
self center == aView ifTrue: [self center: nil].
self west == aView ifTrue: [self west: nil].
self east == aView ifTrue: [self east: nil].
self north == aView ifTrue: [self north: nil].
self south == aView ifTrue: [self south: nil].
^super removeSubView: aView
!
reposition: aMovedView to: aPoint
"Private - If aMovedView is not one of the receivers views then position
it to where it wants to go, otherwise layout the receivers container."
aMovedView position: aPoint.
aMovedView arrangement notNil ifTrue: [
super reposition: aMovedView to: aPoint]!
resize: aSizedView to: aRectangle
"Private - If aSizedView is not one of the receivers views then resize
it to its desired rectangle, otherwise layout the receivers container."
aSizedView rectangle: aRectangle.
aSizedView arrangement notNil ifTrue: [
super resize: aSizedView to: aRectangle].
^self.
!
resolutionScaledBy: scale
"Private - The receiver is being loaded and it has been determined that the pixel resolution
has changed since the point at which the view was saved. Scale any internal pixels by <Point>
scale."
hgap := (hgap * scale x) truncated.
vgap := (vgap * scale x) truncated.
!
south
"Answer the view arranged to the bottom edge of the container
view for which the receiver lays out subviews."
^south!
south: aView
"Set the view arranged to the bottom edge of the container
view for which the receiver lays out subviews."
south := aView!
verticalGap
"Answer the vertical gap between items laid out by the receiver"
^vgap!
verticalGap: anInteger
"set the vertical gap between items laid out by the receiver to be anInteger"
vgap := anInteger!
west
"Answer the view arranged to the left edge of the container
view for which the receiver lays out subviews."
^west!
west: aView
"Set the view arranged to the left edge of the container
view for which the receiver lays out subviews."
west := aView! !
CardLayout comment:
'CardLayout implements a specialised <layoutManager> to layout <view> objects within a <cardView>. It arranges the contained views so that they stack on top of one another in z-order sequence. Only one of the views, the so-called current card, is allowed to be visible at any one time.
The arrangement aspects of the managed views are used as a descriptive names for the cards. The containing <cardView> may make use of these names as it sees fit. For example, a CardContainer uses these as the names for the tabs that it displays.
Instance Variables:
names <OrderedCollection> of names for each of the managed views.
currentCard <view> that is currently visible in the container.
'!
!CardLayout class methodsFor!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #currentCardChanged;
yourself.
! !
!CardLayout methodsFor!
arrangementAspect
"Private - Answer an Aspect description for the arrangement aspect of Views that
are managed by the receiver."
^Aspect string: #arrangement
!
arrangementOf: aView
"Answer the arrangement parameter of aView in the receiver"
'FlowLayout implements a general purpose <layoutManager> to layout <view> objects within a <compositeView>. The views are arranged in a similar manner to words on a page; from left to right and top to bottom. The FlowLayout fits as many views as possible into a single row before moving onto the next row. You can specify the overall alignment of the rows to be #left, #centre or #right. The separation between adjacent components can be specified with the #horizontalGap and #verticalGap aspects.
Note that a FlowLayout takes no notice of the #arrangement aspects of the views that it manages.
A FlowLayout is typically used by a parent Toolbar to manage a series of child bars. This allows the child bars to overflow onto subsequent lines as the parent is re-sized. You can see this effect in action in any of the development tool windows.
Instance Variables:
hgap <integer> horizontal gap between adjacent views
vgap <integer> vertical gap between adjacent views
alignment <Symbol> either #left, #center or #right
'!
!FlowLayout class methodsFor!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
"Answer the vertical gap between items laid out by the receiver"
^vgap!
verticalGap: anInteger
"set the vertical gap between items laid out by the receiver to be anInteger"
vgap := anInteger! !
FramingLayout comment:
'FramingLayout implements a general purpose <layoutManager> to layout <view> objects within a <compositeView>. This is the most complex of the layout managers provided with the base Dolphin image but also the most flexible. Each of the managed views is given a series of constraints which indicate how it should be laid out within the parent. These constraints are instances of FramingConstraints and are specified by setting the #arrangement aspects of the various views. See the class comment for FramingConstraints for more details.
Some examples of the use of FramingLayout managers can be seen in the default views for ChoicePrompter and for AXTypeLibraryPrompter. Try evaluating the following and resizing the dialogs to see the effect.
ChoicePrompter choices: Object subclasses.
AXTypeLibraryPrompter showModal.
Instance Variables:
framings <LookupTable> mapping the managed views to their FramingConstraints
'!
!FramingLayout class methodsFor!
example1
"A simple example of building a view with a framing layout."
'GridLayout implements a general purpose <layoutManager> to layout <view> objects within a <compositeView>. The managed views are arranged in a rectangular grid with dimensions specified by the #rows and #columns aspects. The views are resized to be identical in size and to fill as much of the available area within the container as possible. The separation between the rows and columns can be specified with the #horizontalGap and #verticalGap aspects.
Note that a GridLayout takes no notice of the #arrangement aspects of the views that it manages.
Instance Variables:
rows <integer>
columns <integer>
hgap <integer>
vgap <integer>
'!
!GridLayout class methodsFor!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect integer: #horizontalGap);
add: (Aspect integer: #verticalGap);
add: (Aspect integer: #rows);
add: (Aspect integer: #columns);
yourself! !
!GridLayout methodsFor!
columns
"Answers the number of columns for the receiver"
^columns!
columns: anInteger
"Set the number of columns for the receiver to anInteger.
Zero implies any number of columns"
columns := anInteger!
horizontalGap
"Answer the horizontal gap between items laid out bu the receiver"
^hgap!
horizontalGap: anInteger
"set the horizontal gap between items laid out by the receiver to be anInteger"
hgap := anInteger!
initialize
"Private - Initialize the receiver"
super initialize.
"Set up for a horizontal arrangement in one row"
rows := 1.
columns := 0.
hgap := 0.
vgap := 0.!
layoutContainer: aContainerView
"Performs a layout operation on the contents in aContainerView"
| subviews count insets nrows ncols width height w h x wSpare hSpare |
subviews := aContainerView managedSubViews.
count := subviews size.
count > 0 ifFalse: [^self].
insets := aContainerView actualInsets.
nrows := self rows.
ncols := self columns.
nrows > 0
ifTrue: [ncols := (count + nrows - 1) // nrows]
ifFalse: [nrows := (count + ncols - 1) // ncols].
width := aContainerView clientWidth - (insets left + insets right).
height := aContainerView clientHeight - (insets top + insets bottom).
"Private - The receiver is being loaded and it has been determined that the pixel resolution
has changed since the point at which the view was saved. Scale any internal pixels by <Point>
scale."
hgap := (hgap * scale x) truncated.
vgap := (vgap * scale y) truncated.
!
rows
"Answers the number of rows for the receiver"
^rows!
rows: anInteger
"Set the number of rows for the receiver to anInteger.
Zero implies any number of rows"
rows := anInteger!
verticalGap
"Answer the vertical gap between items laid out by the receiver"
^vgap!
verticalGap: anInteger
"set the vertical gap between items laid out by the receiver to be anInteger"
vgap := anInteger! !
ProportionalLayout comment:
'ProportionalLayout implements a general purpose <layoutManager> to layout <view> objects within a <compositeView>. The managed views are arranged either vertically or horizontally depending on the setting of the <boolean> #isVertical aspect. The layout manager attempts to keep the relative sizes of the views in proportion according to the <number> arrangement aspects of each view. Any view that is given an arrangement of 0 will be left at its original size.
A ProportionalLayout is commonly used in conjunction with one or more Splitters. In the standard ClassBrowserShell default view you can see two ProportionalLayout managers at work; one separating the panes horizontally and one vertically. Each of the panes is separated by a Splitter which, when moved, can be used to adjust the proportions of the views on either side of it. Note that Splitters are always given an arrangement of 0 so they are not resized by the layout manager and can remain at their preferred with.
For example. You have four views in a container managed by a ProportionalLayout; each has an arrangement of 2, 0, 5, 3 respectively. The second view will always keep its current size. The remainder of the space available in the container will be split between the remaining views in the ratios 2:5:3.
Instance Variables:
proportions <Dictionary>
isVertical <boolean>
'!
!ProportionalLayout class methodsFor!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect boolean: #isVertical);
yourself! !
!ProportionalLayout methodsFor!
arrangementOf: aView
"Answer the current proportion for aView. Answer the default
if a specific value has not been set. The proportion is used to size
the views relative to the others managed by the receiver. A value of
"Private - Answer the sum of all the views proportions."
^viewCollection inject: 0 into: [:total :aView |
total + (self arrangementOf: aView)].
!
vertical: aBoolean
"Set the receivers vertical instance variable. This acts
as a mode and is in either vertical or horizontal."
isVertical := aBoolean! !
ScrollingDecoratorLayout comment:
'ScrollingDecoratorLayout implements a specialised <layoutManager> to layout a single <view> object contained within a <scrolllingDecoratorView>. The ScrollingDecoratorLayout does not attempt to resize the managed view but, instead, it repositions it according to scroll information that it receives from the view''s parent. Scrollbars will become available in the parent <scrollingDecoratorView> when its extent goes below the preferred extent recommended by the ScrollingDecoratorLayout.
"Private - Answer an OrderedCollection of rectangles for each of the
elements of subviews."
| position rectangles |
rectangles := OrderedCollection new.
position := offset negated.
subviews
from: 1
to: subviews size - 1
do:
[:view |
| preferredExtent |
preferredExtent := view layoutExtent.
rectangles addLast: (position extent: extent x @ preferredExtent y).
position := position + (0 @ preferredExtent y)].
rectangles addLast: (position extent: extent x @ extent y).
^rectangles! !
ShieldLayout comment:
'ShieldLayout implements a specialised <layoutManager> for use with a <compositeView> in the ViewComposer. All of the managed views in the associated container are resized to occupy the full area of the container. This is used by the ViewComposer to ensure that it''s protective mouse Shield completely covers the editing arena.'!
!ShieldLayout methodsFor!
layoutContainer: aContainerView
"Performs a layout operation on the contents in aContainerView.
This will typically be used to ensure that a Shield view covers
exactly the ContainerView it is shielding.
Each subview will fill the parameter aContainerView.
They will all be the same size."
| rectangle |
rectangle := aContainerView clientRectangle.
aContainerView managedSubViews do: [ :subview |
subview rectangle: rectangle]!
preferredLayoutExtentOf: aContainerView
"Answer aPoint which is the preferred extent when laying out aContainerView"
^aContainerView subViews size=0
ifTrue: [0@0]
ifFalse: [aContainerView subViews last layoutExtent]! !
MoenLink comment:
'MoenLink is a private helper class that is part of the implementation of the <MoenTreeView>'!
'A Process represents an individual thread of execution in the image.
A Process can in any of the following states:
- active The Process is actually running. Usually you will only be able to catch the main UI process in this state.
- debug The Process is currently being debugged.
- ready The Process is ready to run, but currently suspended on one of the Processors priority queues.
- suspended The Process has been suspended (see #suspend), and will not run again until sent #resume.
Note that a suspended process with no active references will be garbage collected.
- waiting The Process is waiting on a <Semaphore>, i.e. it has sent #wait to a Semaphore with no excess signals.
A Process remains waiting on a Semaphore until it reaches the front of that Semaphores queue of
waiting Processes and the Semaphore is sent a #signal message.
- dead The Process has been terminated, or has run to completion.
A Process in any state other than #dead is considered alertable, and may be sent an interrupt by the VM at any time. See<ProcessorScheduler> for more details.
Note that the name "Process" is historic - a Smalltalk Process is much more similar to a "thread" than a true process, since all Processes share the same execution context (the image). Dolphin''s Processes do not map directly onto native threads, but are "green" threads. The multi-threading system is implemented internally by the VM and image, with all "green" threads running within a single Win32 thread. This means that a call to a long running (or blocking) external API call will block the entire system, so a facility is provided to "overlap" such calls. This is done by marking the external method with the "overlap" annotation, in which case the VM will perform the call on a separate native thread. For the duration of the overlapped operation the calling Process is blocked, but other Processes in the image will continue to run.
In general it is not a good idea to manipulate the contents of a live process directly (e.g. in an Inspector). For performance reasons the VM tends to assume that a Process'' state is consistent, and it does not perform much error checking. Hence it is quite easy to crash the system by modification of instance variables and the stack. It is quite safe to view the contents, but if a live Process is inspected you may find that the snapshot is invalidated by the stack growing and shrinking to meet requirements, which could cause errors in the inspector when trying to access non-existant stack slots.
Instance Variables:
suspendedFrame <Integer> address of suspendedFrame when in states ready, waiting, or suspended, otherwise nil.
priority <Integer> priority level (see ProcessorScheduler).
myList <LinkedList> on which the process is currently queued if in states ready or waiting, otherwise nil.
callbackDepth <Integer> number of callbacks which have not yet been returned from (i.e. nested depth).
primitiveFailureCode <Integer> code reported by last primitive failure.
primitiveFailureData <Object> argument supplied by last primitive failure. Value depends on primitive and failure reason.
fpeMask <Integer> floating point exception mask specifying which FP exceptions to mask. See Intel/CRT docs.
tls Reserved for future use.
thread Pointer to overlapped call control block. For VM use only.
exceptionEnvironment List of active exception frames <ExceptionHandler> in LIFO order.
_alreadyPrinted <IdentitySet> of objects which have already printed in a recursive #printOn:
errno <integer>. C runtime library error code recorded after last overlapped external call
debugger <Debugger> associated with the Process, if any. Used as a destination for debug events.
name The <Object> ''name'' of the process. Usually a <String> or <CompiledMethod>.
lastError <integer>. Win32 GetLastError() code recorded after last overlapped external call.
Class Variables:
DefaultFPEMask <Integer> default floating point exception mask used to initialize fpeMask instance variable.
DefaultMaxStack <Integer> maximum stack depth (size up to which a Process may grow - virtual memory reserved).
"Answer a <number> that is the receiver multiplied by itself."
^self * self!
strictlyPositive
"Answer whether the receiver is greater than zero."
^self > self class zero!
subtractFromFloat: aFloat
"Private - Answer the result of subtracting the receiver from the known Float,
aFloat, by coercing the less general of it and the receiver. Overridden by
subclasses which can implement more efficiently."
^aFloat retry: #- coercing: self
!
subtractFromFraction: aFraction
"Private - Answer the result of subtracting the receiver from the known fraction, aFraction,
by coercing the less general of it and the receiver. Overridden by subclasses
which can implement more efficiently."
^aFraction retry: #- coercing: self!
subtractFromInteger: anInteger
"Private - Answer the result of subtracting the receiver from the known integer,
anInteger, by coercing the less general of it and the receiver. Overridden by
subclasses which can implement more efficiently."
^anInteger retry: #- coercing: self!
subtractFromPoint: aPoint
"Private - Answer the result of subtracting the receiver from the known Point,
aPoint, by coercing the less general of it and the receiver. Overridden by
subclasses which can implement more efficiently."
^aPoint retry: #- coercing: self
!
subtractFromPoint3D: aPoint3D
"Private - Answer the result of subtracting the receiver from the known Point3D,
aPoint3D, by coercing the less general of it and the receiver. Overridden by
subclasses which can implement more efficiently."
^aPoint3D retry: #- coercing: self
!
subtractFromScaledDecimal: operand
"Private - Answer the result of subtracting the receiver from the
known <ScaledDecimal>, operand."
^operand retry: #- coercing: self!
truncated
"Answer the <integer> nearest the receiver toward zero"
^self quo: 1!
truncateTo: factor
"Answer the next multiple of the <number> argument, factor, that is nearest the receiver
toward zero."
^((self quo: factor) * factor)
!
understandsArithmetic
"Answer whether the receiver understands basic arithmetic (+, -, etc).
All Numbers do."
^true! !
Association comment:
'Association is a simple class to encapsulate the relationship between
a key and a value. It is used for the elements of Dictionaries.'!
!Association class methodsFor!
key: aKey value: aValue
"Answer a new instance of the receiver whose key is aKey and
value is aValue."
<primitive: 157>
^self new key: aKey value: aValue
! !
!Association methodsFor!
< anAssociation
"Answer whether the receiver is considered 'less than' the argument."
^key < anAssociation key!
= anAssociation
"Answer whether the receiver is equal to the argument."
^self species == anAssociation species
and: [key = anAssociation key
and: [value = anAssociation value]]!
displayOn: aStream
"Append a short textual description of the receiver to aStream."
aStream
display: key;
nextPutAll: ' -> ';
display: value!
hash
"Answer the hash value of the receiver's key."
^key hash
!
key
"Answer the lookup key of the receiver."
^key
!
key: aKey
"Set the lookup key of the receiver."
key := aKey
!
key: aKey value: aValue
"Set the instance variables of the receiver to aKey->aValue"
key := aKey.
value := aValue
!
owningPackage: aPackage
aPackage addGlobalNamed: self key!
printOn: aStream
"Append a short textual description of the receiver to aStream."
aStream
print: key;
nextPutAll: ' -> ';
print: value!
value
"Answer the 'value' of the receiver."
^value!
value: aValue
"Set the 'value' of the receiver. N.B. The meaning of #value: to an Association
is not the same as that defined by the ANSI monadic valuable protocol."
value := aValue
! !
Character comment:
'Character is the class of objects which serve as the elemental values of Smalltalk Strings. There is a finite set of Characters (256 in the current Dolphin implementation). Characters have a literal syntax which is the $ symbol followed by the normal printed representation of the character.
Note that the ANSI standard does not require that Characters be identity objects, but they are in Dolphin.
'!
!Character class methodsFor!
backspace
"Answer the backspace Character"
^##(self value: 8)
!
basicNew
"Characters are immediate objects, and cannot be instantiated directly, they
can only be created by literal references, by operations on other Characters,
or with the Character>>value: message."
^self shouldNotImplement!
byteCharacterSet
"Answer the first 256 characters"
^CharacterSet!
codePoint: integer
"Answer an instance of the receiver with the <integer> encoding, integer.
Note that at present the encodings are limited to 0..255, but in a future
release the Unicode character set will be supported, and the encoding
range will then be 0..65535."
^self value: integer!
cr
"Answer the carriage return <Character>."
^##(self value: 13)!
digitValue: anInteger
"Answer the Character that corresponds to anInteger. 0-9 map to $0-$9,
10-35 map to $A-$Z. If anInteger is not in the range
0..35, then the String #at: will fail with a bounds error."
"Answer a <Float> which is the sine of the receiver,
which is treated as an angle in radians."
^self asFloat sin!
sqrt
"Answer a <number> which is the positive square root of the receiver."
^self asFloat sqrt!
tan
"Answer a <Float> which is the tangent of the receiver,
which is treated as an angle in radians."
^self asFloat tan!
to: stop
"Answer an <interval> from the receiver up to the argument, stop, with an interval of 1
between elements."
^Interval from: self to: stop!
to: stop by: step
"Answer an <interval> from the receiver up to the argument, stop, with an interval of
the argument, step, between elements."
^Interval from: self to: stop by: step!
to: stop by: step do: operation
"Evaluate the <monadicBlock> argument, operation, for each <number> between the
receiver and the <number> argument, stop, in increments of the <number> argument, step.
N.B. This implementation is not normally used since #to:by:do: is optimized by the compiler."
(self to: stop by: step) do: operation!
to: stop do: operation
"Evaluate the <monadicBlock> operation passing it the <number> sequence beginning
with the receiver, and incrementing by one until the <number> argument, stop, is reached,
inclusive.
Implementation Note: This method is critical to overall system performance, and is normally inlined by
the compiler, so this implementation is used only when #perform:'ed."
(self to: stop) do: operation! !
Point comment:
'A Point represents an x-y pair of numbers usually indicating a point on a two-dimensional Cartesian coordinate plane. Points are often used to designate the location of pixels within a Bitmap or on the display screen. By Smalltalk convention, x increases to the right and y down, consistent with the layout of text on a page and with pixels in Windows'' bitmaps. This "left-handed" coordinate system is the convention for Points used within the standard Smalltalk image (in classes such as Rectangle) but there is nothing in the Point class itself that prohibits the implied use of a "right-handed" coordinate system in which y increases in the upward direction.
A Point is typically created using the binary message @ to a Number:
150 @ 200
Arithmetic operations can be carried out between two Points or between a Point and a Number. Each of the arithmetic messages returns a new Point as the result. Note the need to make use of parentheses in the expressions below due to the equal precedence assigned to all binary messages (such as @ and +).
(150 @ 200) + (50 @ 50) "Addition of Points"
(150 @ 200) + 100 "Addition of scalar"
(150 @ 200) * 3 "Scaling"'!
!Point class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Answer a new instance of the receiver equal to zero."
^self zero!
one
"Answer the receiver's representation of one."
^1 @ 1!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect integer: #x);
add: (Aspect integer: #y);
yourself!
uninitialize
"Private - Tidy up the receiver in preparation for removal from the system."
VMLibrary default registryAt: #Point put: nil!
x: xCoord y: yCoord
"Answer a new instance of the receiver with the specified
x and y coordinates"
<primitive: 157>
^self basicNew x: xCoord y: yCoord!
zero
"Answer the receiver's representation of zero."
^0 @ 0! !
!Point methodsFor!
- anArithmeticValue
"Answer the receiver minus anArithmeticValue as a Point."
^anArithmeticValue subtractFromPoint: self!
* anArithmeticValue
"Answer a Point with the receiver's coordinates multiplied by anArithmeticValue."
^anArithmeticValue multiplyByPoint: self!
/ operand
"Answer a Point with the receiver's coordinates divided by the <number>,
operand. If the operand is zero then a <ZeroDivide> is raised."
^operand divideIntoPoint: self!
@ zCoord
"Answer a Point3D with the receiver as X, Y coordinates and the argument as Z."
^Point3D x: x y: y z: zCoord!
+ anArithmeticValue
"Answer the sum of receiver and aPoint as a Point."
^anArithmeticValue addToPoint: self!
< anArithmeticValue
"Answer whether the receiver is above and to the left of anArithmeticValue.
N.B. No double dispatch, as would need to do for more than just #<."
| aPoint |
aPoint := anArithmeticValue asPoint.
^x < aPoint x and: [ y < aPoint y ]!
<= anArithmeticValue
"Answer whether the receiver is neither below nor to the right of anArithmeticValue.
A double dispatch of #< with the superclass implementation of #<= would not work here."
| aPoint |
aPoint := anArithmeticValue asPoint.
^x <= aPoint x and: [ y <= aPoint y ]!
= comperand
"Answer whether the receiver is considered equivalent to the
<Object> argument, comperand."
^self species == comperand species
ifTrue: [x = comperand x and: [y = comperand y]]
ifFalse: [super = comperand]!
> anArithmeticValue
"Answer whether the receiver is below and to the right of anArithmeticValue.
A double dispatch of #< with the superclass implementation of #> would not work here."
| aPoint |
aPoint := anArithmeticValue asPoint.
^x > aPoint x and: [y > aPoint y]
!
>= anArithmeticValue
"Answer whether the receiver is neither above nor to the left of anArithmeticValue.
A double dispatch of #< with the superclass implementation of #>= would not work here."
| aPoint |
aPoint := anArithmeticValue asPoint.
^x >= aPoint x and: [ y >= aPoint y ]
!
abs
"Answer a <Point> that is the absolute value (positive magnitude) of the receiver."
^x abs @ y abs!
addToPoint: aPoint
"Private - Answer the result of adding the receiver to the known Point,
aPoint, by coercing the less general of it and the receiver. Overridden by
subclasses which can implement more efficiently."
^(aPoint x + x) @ (aPoint y + y)!
asDword
"Answer the receiver in a form suitable for returning as the result of a window
procedure (or passing to a function expecting a 32-bit value)."
^self asParameter asDword!
asParameter
"Answer the receiver in a form suitable for passing to an external function."
^POINTL fromPoint: self!
asPoint
"Answer the receiver"
^self!
asPoint3D
"Answer a Point3D with the receiver."
^self x @ self y @ 0!
ceiling
"Answer a new Point with the x and y values of the receiver truncated
toward positive infinity."
^x ceiling @ y ceiling!
coerce: anArithmeticValue
"Private - Answer the lower generality ArithmeticValue, anArithmeticValue,
converted to a Point."
^anArithmeticValue asPoint!
corner: aPoint
"Answers a Rectangle defined by the receiver and aPoint."
^Rectangle origin: self corner: aPoint!
degrees
"Answer the angle the receiver makes with origin in degrees. right is 0; down is 90."
| tan theta |
x = 0
ifTrue: [y >= 0
ifTrue: [^ 90.0]
ifFalse: [^ 270.0]]
ifFalse:
[tan := y asFloat / x asFloat.
theta := tan arcTan.
x >= 0
ifTrue: [y >= 0
ifTrue: [^theta radiansToDegrees]
ifFalse: [^360.0 + theta radiansToDegrees]]
ifFalse: [^180.0 + theta radiansToDegrees]]!
dist: aPoint
"Answer the distance between aPoint and the receiver."
^(aPoint - self) r!
divideIntoPoint: aPoint
"Private - Answer the result of dividing the receiver into the known Point, aPoint, by
coercing the less general of it and the receiver. Overridden by subclasses which
can implement more efficiently."
^(aPoint x / x) @ (aPoint y / y)!
dotProduct: aPoint
"Answer a Number that is the sum of the product of the x coordinates
and the product of the y coordinates of the receiver and aPoint"
^(x * aPoint x) + (y * aPoint y)!
extent: aPoint
"Answers a Rectangle whose origin is the receiver and whose
extent is the argument aPoint"
^Rectangle origin: self extent: aPoint!
floor
"Answer a new Point with the x and y values of the receiver truncated
toward negative infinity."
^x floor @ y floor!
generality
"Private - Answer the Smalltalk generality of the receiver, used for performing type conversions"
^50!
hash
"Answer the <integer> hash value for the receiver."
^(x hash bitShift: 2) bitXor: y hash!
max: aPoint
"Answer a new Point with the maximum of the x coordinates
and the maximum of the y coordinates of the receiver and aPoint"
^(x max: aPoint x) @ (y max: aPoint y)!
min: aPoint
"Answer a new Point with the maximum of the x coordinates
and the maximum of the y coordinates of the receiver and aPoint"
^(x min: aPoint x) @ (y min: aPoint y)!
multiplyByPoint: aPoint
"Private - Answer the result of multiplying the known Point, aPoint,
by the receiver, by coercing the less general of it and the recever.
Overridden by subclasses which can implement more efficiently."
^(x * aPoint x) @ (y * aPoint y)!
printOn: target
"Append a short textual description of the receiver to the
<puttableStream>, target."
target
print: x;
nextPut: $@;
print: y!
r
"Answer the receiver's radius (magnitude) in a polar coordinate
system."
^(self dotProduct: self) sqrt!
raisedTo: operand
"Answer an <ArithmeticValue> which is the receiver raised to the power of
the <number> argument, operand."
^(x raisedTo: operand) @ (y raisedTo: operand)!
rounded
"Answer a new Point with the x and y values of the receiver rounded.
Implementation Note: Superclass implemenation works, but we can do it more efficiently."
^x rounded @ y rounded!
subtractFromPoint: aPoint
"Private - Answer the result of subtracting the receiver from the known Point,
aPoint, by coercing the less general of it and the receiver. Overridden by
subclasses which can implement more efficiently."
^(aPoint x - x) @ (aPoint y - y)!
transpose
"Answer a new Point with the x and y coordinates of the receiver
reversed"
^y @ x!
truncated
"Answer a new Point with the x and y values of the receiver truncated toward zero"
^x truncated @ y truncated!
x
"Answer the receiver's x coordinate"
^x!
x: aNumber
"Set the receiver's x coordinate"
x := aNumber!
x: xCoord y: yCoord
"Private - Set the x and y coordinates of the receiver.
Primarily intended for instance creation. Answer the receiver."
x := xCoord.
y := yCoord!
y
"Answer the receiver's y coordinate"
^y!
y: aNumber
"Set the receiver's y coordinate"
y := aNumber! !
Point3D comment:
'A Point3D represents an x-y-z pair of numbers usually indicating a point in a three-dimensional Cartesian coordinate volume. Following the convention for Point, Point3D is often attributed a "left-handed" coordinate system. However, this is not essential and either left or right-handed systems may be adopted depending on the application.
A Point3D is typically created using the binary message @ to a Point:
150 @ 200 @ 400
Arithmetic operations can be carried out between two Point3Ds or between a Point3D and a Number. Each of the arithmetic messages returns a new Point3D as the result. Note the need to make use of parentheses in the expressions below due to the equal precedence assigned to all binary messages (such as @ and +).
"Answer a new Point3D with the x, y and z values of the receiver rounded."
^x rounded @ y rounded @ z rounded!
subtractFromPoint3D: aPoint3D
"Private - Answer the result of subtracting the receiver from aPoint3D"
^(aPoint3D x - x) @ (aPoint3D y - y) @ (aPoint3D z - z)
!
truncated
"Answer a new Point3D with the x, y and z values of the receiver truncated."
^x truncated @ y truncated @ z truncated!
x
"Answer the x coordinate of the receiver"
^x!
x: aNumber
"Set the x coordinate of the receiver"
x := aNumber!
x: xCoord y: yCoord z: zCoord
"Set the coordinates of the receiver with the specified
x, y and z coordinates"
x := xCoord.
y := yCoord.
z := zCoord.!
y
"Answer the y coordinate of the receiver"
^y!
y: aNumber
"Set the y coordinate of the receiver"
y := aNumber!
z
"Answer the z coordinate of the receiver"
^z!
z: aNumber
"Set the z coordinate of the receiver"
z := aNumber! !
Float comment:
'Float is the class of double precision floating point Numbers (64-bit) in IEEE-754 format. Note that the original Smalltalk-80 definition of Float, was only single precision, but this is considered somewhat outdated. Rather than introduce the complexity of multiple classes to represent floating point numbers, we have chosen to standardise on double precision.
Class Variables:
SignificantDifference <Float>. Difference between two Floats which is considered sufficient to deem them unequal. The smallest this can be is Float class>>epsilon.
DefaultSigFigs <SmallInteger>. Default digits of precision displayed.
'!
!Float class methodsFor!
denormalized
"Answer whether the characterized floating point representation allows denormalized
"Answer the <integer> nearest the receiver toward zero.
Note that for many large floats the answer may be reported
to more digits of precision that the floating point receiver
was capable of representing (there are only about 15 digits
of precision in a double).
Implementation Note: Rather than calculate the integer approximation
by a series of divisions (as in versions of Dolphin prior to 3.02), a
process which was both very slow for large Floats and also prone
to error, we use precise #asTrueFraction.
Primitive failure results:
0 - the receiver is not finite.
1 - more than 64-bits are required to represent the receiver
as an Integer.
May also raise a floating point exception."
<primitive: 166>
^self asTrueFraction truncated
! !
Fraction comment:
'Instances of class Fraction represent rational numbers which are not integers, e.g. 3/4. They are always represented in the most reduced form possible. Fractions are usually created by a division operation between two integers where the numerator cannot be divided exactly the denominator. Unlike Float, Fraction has effectively limitless precision, and thus calculations involving Fractions do not suffer from rounding errors. This can be useful where absolute accuracy is required, but Fraction arithmetic is not supported directly by the CPU, and thus calculations are orders of magnitude slower.
Instance Variables:
numerator <integer>
denominator <integer>
'!
!Fraction class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
numerator: top denominator: bottom
"Answer a <Fraction> with numerator and denominator,
initialised to the <integer> arguments, top, and, bottom.
It is assumed that the arguments are such that a normalised
<Fraction> will result - use #normalisedNumerator:denominator if
you're not sure and require the smallest possible denominator."
^self basicNew numerator: top denominator: bottom!
"Evaluate aBlock repeatedly, once for each integer from 1 to the floor of
the receiver. Note that this message is normally optimised by the Compiler."
1 to: self do: [:i | aBlock value]!
truncated
"Answer the integer nearest the receiver toward zero."
^self
! !
ScaledDecimal comment:
'ScaledDecimal is a Number class to represent fixed point decimal numbers. It supports unbounded precision, with no practical limit to the number of digits before and after the decimal point.
ScaledDecimal conforms to the following ANSI protocols:
Float
magnitude
number
Object
rational
scaledDecimal
A ScaledDecimal represents a value as a Fraction and the number of digits after the decimal point. This representation allows us to take advantage of the implementation of unbounded rational numbers provided by Fraction with very small amount of simple code.
We are grateful to Richard A. Harmon for contributing his ANSI compliant ScaledDecimal implementation from which this class was derived.
'!
!ScaledDecimal class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
"Answer a <ScaledDecimal> which is the reciprocal of the receiver (i.e. 1/receiver).
Raise a ZeroDivide exception if the receiver is zero.
Implementation Note: Override because we can implement this much more
efficiently by simply flipping over our Fraction (done in its own efficient reciprocal)."
^self species
newFromNumber: fraction reciprocal
scale: scale
!
scale
"Answer an <integer> which represents the total number of digits used to
represent the fraction part of the receiver, including trailing zeroes."
^scale
!
setFraction: f scale: s
"Private - Initialize the receiver's identity variables."
fraction := f.
scale := s.
!
subtractFromScaledDecimal: operand
"Private - Answer the result of subtracting the receiver from the
known <ScaledDecimal>, operand."
^self species
newFromNumber: operand asFraction - fraction
scale: (scale max: operand scale)!
truncated
"Answer the <integer> nearest the receiver toward zero."
^fraction truncated
! !
LargeInteger comment:
'Class LargeInteger is the class of Integers which are outside the range of SmallIntegers (i.e. outside (SmallInteger minimum..SmallInteger maximum). Basically any Integer requiring more than 31-bits to be represented in 2''s complement will be a LargeInteger.
LargeIntegers in Dolphin do not follow the standard signed-magnitude radix-256 Smalltalk representation, with separate subclasses for positive and negative integers. Dolphin''s LargeIntegers follow standard machine representation, in that they are 2''s complement, 32-bit granular (i.e. they might have 32, 64, 96, ...n*32 bits). This representation has the dual advantages of higher performance, and simplified external interfacing. In particular the 32 and 64-bit Integers have the same representation externally as they do in Dolphin.
LargeInteger includes high performance primitive implementations for the common arithmetical operations and bit manipulations.'!
!LargeInteger class methodsFor!
fromBytes: bytes
"Answer an instance of the receiver instantiated from the the byte object, bytes,
which is assumed to contain a positive Integer magnitude."
| size answer |
size := bytes size.
answer := self basicNew: (size roundUpTo: 4) + 4.
1 to: size do: [:i | answer basicAt: i put: (bytes basicAt: i)].
^answer normalize!
fromSmallInteger: anInteger
"Private - Answer an instance of the receiver representing the SmallInteger value,
anInteger. Note that the result is NOT normalized, as otherwise the answer
would just be the SmallInteger!! Because the answer is not normalized, it is
not strictly a valid LargeInteger in all circumstances, hence this routine is
private."
^(self basicNew: 4)
sdwordAtOffset: 0 put: anInteger;
yourself!
new: anInteger
"Private - Answer a new LargeInteger of the requested number of 32-bit digits."
^self basicNew: (anInteger bitShift: 2)!
new64
"Private - Answer a new 64-bit LargeInteger.
N.B. The answer is not a valid LargeInteger since zero is a SmallInteger."
^self basicNew: 8! !
!LargeInteger methodsFor!
- operand
"Answer a <number> which is the difference between the receiver and the <number> argument,
operand."
<primitive: 22>
^operand subtractFromInteger: self!
* operand
"Answer the <number> result of multiplying the receiver by
the <number> argument, operand."
<primitive: 29>
^operand multiplyByInteger: self!
/ operand
"Answer the <number> which is the result of dividing the receiver by <number> argument,
operand. If their is any remainder, then the result will be a <Fraction>. Raise a <ZeroDivide>
exception if the operand is zero."
<primitive: 30>
^operand divideIntoInteger: self!
// operand
"Answer a <number> which is the quotient resulting from dividing the receiver
by the <number> argument, operand, with truncation towards negative infinity."
<primitive: 32>
^super // operand!
\\ operand
"Answer the <integer> remainder defined by division with truncation toward negative
The answer is always of the same sign as the receiver, regardless of
the sign of the argument."
^(self quoAndRem: operand) basicAt: 2!
sdwordAtOffset: anInteger
"Private - Answers the signed 4 byte integer at byte offset anInteger in the receiver.
Primitive failure reasons:
0 - anInteger is not a SmallInteger
1 - anInteger is out of bounds."
| answer |
<primitive: 122>
^self primitiveFailed!
sdwordAtOffset: anInteger put: anObject
"Private - Store anObject as a signed integer at anInteger offset in the receiver. anInteger must
be representable in 32-bits. Uses the dwordAtOffset:put: primitive."
| int |
<primitive: 123>
int := anObject asInteger.
int isSDWORD ifFalse: [^self errorCantHold: anObject].
1 to: 4 do: [:index | self basicAt: anInteger + index put: (int at: index)].
^int!
signBit
"Private - Answer the receiver's sign bit. This will be 0 for positive integers
and 1 for negative integers."
^(self basicAt: self basicSize) bitShift: -7!
size
"Answer the number of 32-bit words in the receiver."
^self basicSize bitShift: -2!
subtractFromInteger: anInteger
"Private - Subtract the receiver from the known integer, anInteger
and answer the result.
N.B. The negated receiver may not be large if the receiver is 16r40000000
and therefore it is better to send #+ that #addToInteger:."
^self negated + anInteger! !
SmallInteger comment:
'Class SmallInteger is an optimized representation of 31-bit 2''s complement integers.
Wherever an Integer may be represented as a SmallInteger, then its only truly valid representation is as a SmallInteger. (i.e their "normalized" representation is as a SmallInteger). The range is such that the majority of integers used for counting and indexing, and even arithmetical tasks, will be SmallIntegers.'!
!SmallInteger class methodsFor!
basicNew
"SmallIntegers are immediate objects, and cannot be instantiated directly, they
can only be created by literal references or by operations on other SmallIntegers."
^self shouldNotImplement!
hasImmediateInstances
"Answer whether the receiver's instances are immutable objects encoded entirely
in an Oop (e.g. SmallIntegers)."
^true!
maxBytes
"Answer the largest number of radix-256 digits which can be represented
in a SmallInteger (31-bits, so not all 4 byte numbers will fit)."
^4!
maximum
"Answer the largest positive integer value which can be
represented as a SmallInteger."
^16r3FFFFFFF!
minimum
"Answer the largest negative integer value which can be
represented as a SmallInteger"
^-16r40000000! !
!SmallInteger methodsFor!
- operand
"Answer the result of subtracting the <number>, operand, from the receiver.
Primitive failure codes:
0 - operand is not a SmallInteger."
<primitive: 14>
^operand subtractFromInteger: self!
& anInteger
"Answer the result of a bitwise AND between the receiver and the argument, anInteger.
N.B. Use of #bitAnd: is preferred (even though it is more typing) because it is
a special selector (i.e. it is more compact and faster), and is portable.
Primitive failure codes:
0 - anInteger is not a SmallInteger."
<primitive: 40>
^anInteger bitAnd: self!
* aNumber
"Answer the result of multiplying the receiver by aNumber.
Primitive failure codes:
0 - aNumber is not a SmallInteger.
1 - the result requires more than 31-bits to represent.
When the primitive fails we use a double dispatch to ask aNumber to multiply the receiver,
which we know to be a kind of Integer, by itself."
<primitive: 9>
^aNumber multiplyByInteger: self!
/ operand
"Answer the result of dividing the receiver by the <number>, operand.
Attempted division by zero will cause a <ZeroDivide> exception to be
raised.
Primitive failure codes:
0 - aNumber is not a SmallInteger.
2 - the result cannot be represented exactly as an Integer."
<primitive: 10>
^operand divideIntoInteger: self!
// aNumber
"Answer the integer quotient defined by division with truncation toward negative
infinity.
Primitive failure codes:
0 - aNumber is not a SmallInteger.
Attempted division by zero will cause a ZeroDivide exception to be
raised by the VM."
<primitive: 12>
^super // aNumber!
\\ aNumber
"Answer the integer remainder defined by division with trunction toward negative infinity. This is
the modulo operation. N.B. This is not the same as the C/C++ modulus operator (%), which always
truncates towards zero.
Primitive failure codes:
0 - aNumber is not a SmallInteger.
Attempted division by zero will cause a ZeroDivide exception to be
raised by the VM."
<primitive: 11>
^super \\ aNumber!
| anInteger
"Answer the result of a bitwise OR between the receiver and the argument, anInteger.
N.B. Use of #bitOr: is preferred (even though it is more typing) because it is
a special selector (i.e. it is more compact and faster), and is portable.
Primitive failure codes:
0 - anInteger is not a SmallInteger."
<primitive: 41>
^anInteger bitOr: self!
+ aNumber
"Add the argument, aNumber, to the receiver and answer the result.
Primitive failure codes:
0 - aNumber is not a SmallInteger."
<primitive: 15>
^aNumber addToInteger: self!
< aNumber
"Answer whether the receiver is less than the argument, aNumber.
Primitive failure codes:
0 - aNumber is not a SmallInteger."
<primitive: 18>
^aNumber greaterThanInteger: self!
<< anInteger
"Answer the result of shifting the receiver left anInteger bits."
<primitive: 43>
^self bitShift: anInteger!
<= aNumber
"Answer whether the receiver is numerically less than or equal to the argument aNumber.
Primitive failure codes:
0 - aNumber is not a SmallInteger."
<primitive: 20>
^super <= aNumber!
= aNumber
"Answer whether the receiver is equal to aNumber. Numbers are considered
equal if their difference is zero.
Primitive failure codes:
0 - aNumber is not a SmallInteger."
<primitive: 16>
^super = aNumber!
> aNumber
"Answer whether the receiver is greater than the argument, aNumber.
Primitive failure codes:
0 - aNumber is not a SmallInteger."
<primitive: 19>
^super > aNumber!
>= aNumber
"Answer whether the receiver is greater than or equal to the argument, aNumber.
Primitive failure codes:
0 - aNumber is not a SmallInteger."
<primitive: 17>
^super >= aNumber!
allMask: mask
"Answer whether all of the bits that are set in the <integer> mask are also set in
the receiver.
Primitive failure reasons:
0 - mask is not a SmallInteger."
<primitive: 146>
^super allMask: mask!
anyMask: mask
"Answer whether any of the bits that are set in the <integer> mask are also set
in the receiver.
Primitive failure reasons:
0 - mask is not a SmallInteger."
<primitive: 145>
^super anyMask: mask!
asFloat
"Answer the floating point representation of the receiver. The primitive should not fail."
aString at: i put: (Character digitValue: ( value \\ 10 )).
i := i - 1.
value := value // 10].
aString at: i put: (Character digitValue: (value \\ 10 )).
^aString copyFrom: i to: aString size"!
quo: aNumber
"Answer the integer quotient defined by division with truncation toward zero.
Primitive failure codes:
0 - aNumber is not a SmallInteger.
Attempted division by zero will cause a ZeroDivide exception to be
raised by the VM."
<primitive: 53>
^(aNumber quoAndRemFromInteger: self) basicAt: 1
!
quoAndRem: aNumber
"Answer a 2-element array containing the integer quotient and remainder
resulting from division of the receiver by the argument with truncation
toward zero.
Primitive failure codes:
0 - aNumber is not a SmallInteger.
Attempted division by zero will cause a ZeroDivide exception to be
raised by the VM."
<primitive: 13>
^aNumber quoAndRemFromInteger: self!
shallowCopy
"SmallIntegers have an immediate representation - i.e. they have only
one representation for a particular value - and are immutable."
^self
!
size
"We must override the primitive implementation in Object, which does
not expect to be invoked for SmallInteger receivers."
^self shouldNotImplement!
species
"Answer the 'species' of the receiver.
Implementation Note: The primitive superclass implementation
will fail for immediate classes, so we must override here."
^SmallInteger!
yourAddress
"Answer the address of the bytes of the receiver.
Assume that the integer is being used as an address, so answer self."
^self! !
CommandMenuItem comment:
'CommandMenuItem represents a <commandSource> menu item held by a <Menu>. The item is configured with a <CommandDescription> to be fired when the item is chosen..
Instance Variables:
commandDescription <CommandDescription> indicating the command to be fired for the item.
image <Icon> currently associated with the menu item, if any.
bitmap <Bitmap> cached bitmap representation of the image, if any
'!
!CommandMenuItem class methodsFor!
command: action description: text
"Answer a new instance of the receiver containing a <CommandDescription> composed
from the niladicValuable>, action, and the <readableString> description, text."
"Output the receiver to anSTBOutFiler. We don't want the cached images to be saved."
anSTBOutFiler override: image with: nil.
anSTBOutFiler override: bitmap with: nil.
super stbSaveOn: anSTBOutFiler!
text
"Private - Answer the menu text (i.e. the text that appears in the menu) for the receiver."
^self commandDescription menuText! !
DividerMenuItem comment:
'DividerMenuItem represents a divider that can be placed between other items in a <Menu>. Separate singleton instances for the various styles are held in class variables and answered by the #separator, #break and #barBreak [instance creation] methods.
Instance Variables:
flags <integer> Windows style flags
Class Variables:
Separator <DividerMenuItem> singleton instance for the standard separator style.
DividerLookup <LookupTable> mapping <integer> style flags to their <Symbol> style names.
BarBreak <DividerMenuItem> singleton instance for the bar-break separater style.
Break <DividerMenuItem> singleton instance for the break separater style
'!
!DividerMenuItem class methodsFor!
barBreak
"Answer unique DividerMenuItem which splits places following menu items in
a new column. Vertical line splits the old and new column of menu items."
"Private - Answer the menu text (i.e. the text that appears in the menu) for the receiver."
^''! !
MessageSendAbstract comment:
'A MessageSendAbstract is the abstract base class of fully closed <Message>s, that include a receiver object, a message selector, and an array of sufficient arguments. As a fully closed valuable, Message Sends can be evaluated by sending them the #value message, and they can frequently be employed where a <BlockClosure> might otherwise be used.
Athough Message Sends are complete in themselves, they also respond to the valuable messages which take arguments. The general principle is that the supplied arguments supplant those stored in the Message Send according to some algorithm determined by the particular subclass.'!
!MessageSendAbstract class methodsFor!
receiver: anObject selector: aSymbol
"Answer a new instance of the receiver with the receiver, anObject, and selector,
'An EventMessageSend is a fully closed <Message>, including receiver object, the message selector, and an array of sufficient arguments, however the receiver is referenced weakly.
When evaluate with extra arguments, an EventMessageSend merges its own argument with those supplied at evaluation time with the latter taking precedence from the left. For example if the message requires two arguments, and one is supplied at evaluation time, then the first argument sent will be that one, and the second the second of the arguments stored in the EventMessageSend itself.'!
"Removes all the messages in this sequence that are destined for anObject. Answers the receiver."
| corpse |
corpse := DeadObject current.
1 to: receivers basicSize
do:
[:index |
(receivers at: index) == anObject
ifTrue:
[tally := tally - 1.
receivers at: index put: corpse. "corpse marks empty slots"
messages at: index put: nil]]!
size
"Answers the number of messages in the receiver"
^tally! !
MessageSequence comment:
''!
!MessageSequence class methodsFor!
withMessages: aSequencedReadableCollection
"Answer a new instance of the receiver with the specified sequence of <MessageSend>s."
| answer |
answer := self new.
answer list addAll: aSequencedReadableCollection.
^answer! !
!MessageSequence methodsFor!
add: aMessage
"Adds aMessage to the end of this sequence. Answers aMessage"
^list addLast: aMessage.
!
add: newElement afterIndex: index
"Add newElement to the receiver immediately after the element currently at the
specified <integer> index. index must be between 0 and the receiver's current
size (if not raise an exception). Answer newElement."
^list add: newElement afterIndex: index!
addAll: newElements afterIndex: index
"Add all of the elements in the <collection>, newElements, after the existing element of
the receiver at the one-based <integer> index, index. Answer the newly added elements."
^list addAll: newElements afterIndex: index!
initialize
"Private - Initialize the receiver"
super initialize.
list := OrderedCollection new.!
list
"Private - Answers the message list"
^list!
messagesDo: aBlock
"Private - Enumerates through the receiver"
^list do: aBlock!
removeMessagesFor: anObject
"Removes all the messages in this sequence that are destined for anObject.
Answer the receiver."
list := list reject: [ :each | each receiver == anObject]!
size
"Answers the number of messages in the sequence"
^list size! !
AspectBuffer comment:
'An AspectBuffer is used to buffer changes to the aspects of a subject object. These changes are held in a copy of the subject until the buffer receives an #apply message. A client of the buffer can request an aspect for the subject using #aspectValue: and it will receive an appropriate <ValueAspectAdapter>. Only the aspects that have been explicitly requested and then modified will be updated back to the subject when #apply is received.
In order to be correctly used with an AspectBuffer, a subject object must be able to be sensibly duplicated using #copy. The advantage of keeping a complete copy of the subject within the buffer is that the validity of any changes made to it can be tested using #isValid before the changes are applied back. By default the validation check is made by sending #isValid to the subject copy. This default can be modified by changing the isValidBlock in the buffer.
Instance Variables:
subject <Object> which is the subject whose aspects are being buffered.
subjectCopy <Object> copy of the subject.
aspects <IdentityDictionary> mapping put selectors of changed aspects to their values.
gate <ValueHolder> which when set true apply changes back to the subject.
isValidBlock <monadicValuable> to determine of the subject copy is valid before applying changes.
'!
!AspectBuffer class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Private - Use #subject:"
self shouldNotImplement!
subject: aSubjectModel
"Answer an instance of the receiver that buffers the aspects of aSubjectModel"
^super new subject: aSubjectModel
! !
!AspectBuffer methodsFor!
apply
"Apply the aspects held by the receiver in the model copy back to the
original model"
aspects do: [:each |
self subject perform: each putSelector with: each value ]
!
aspectValue: anAspectSymbol
"Answer a ValueAspectAdapter for anAspectSymbol of our copied model.
If a request for this aspect has already been registered then the same
adapter model is answered. Otherwise a new one is created and registered
'A PersonalAccountTransaction holds details regarding a single transaction for an account within the PersonalMoney system.
Instance Variables
amount <Number> containing the amount of the transaction.
description <String> describing the purpose of the transactions.
date <Date> on which the transaction was made.
isDebit <Boolean> that indicates whether the transaction is a debit or credit.'!
!PersonalAccountTransaction methodsFor!
actualAmount
"Answer the actual amount of the receiver taking into consideration
whether it is a debit or credit transaction"
^self isDebit
ifTrue: [ self amount negated ]
ifFalse: [ self amount ]!
amount
"Answer the amount of the receiver"
^amount!
amount: aNumber
"Set the amount of the receiver to aNumber"
amount := aNumber!
date
"Answer the date of the receiver"
^date!
date: aDate
"Set the date of the receiver to aDate"
date := aDate!
description
"Answer the String description of the receiver"
^description!
description: aString
"Set the description of the receiver to aString"
description := aString!
displayOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a user
would want to see it."
self date displayOn: aStream.
aStream nextPutAll: ': '.
aStream nextPutAll: self description.
aStream nextPutAll: (self isDebit
ifTrue: [' - debit ']
ifFalse: [ ' - credit ']).
self amount displayOn: aStream.
!
initialize
"Private - Initialize the receiver"
date := Date today.
description := String new.
amount := 0.0.
isDebit := true!
isDebit
"Answer true if the receiver is a Debit transaction"
^isDebit!
isDebit: aBoolean
"Set the receiver to a Debit transaction according to aBoolean.
If aBoolean is true then the receiver is treated as a credit"
isDebit := aBoolean!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a developer
would want to see it."
aStream
basicPrint: self;
nextPut: $(;
display: self;
nextPut: $)! !
PersonalMoney comment:
'PersonalMoney represent the entirety of the Personal Money system for a single user. It hold owner details and a collection of accounts for this user.
Instance Variables
owner <String> containing the owner''s name
accounts <OrderedCollection> of PersonalAccounts.'!
!PersonalMoney methodsFor!
accounts
"Answer the accounts collection"
^accounts!
addAccount: aPersonalAccount
"Add aPersonalAccount to the collection of accounts owned by the receiver.
Answers aPersonalAccount"
^self accounts add: aPersonalAccount!
initialize
"Private - Initialize the receiver"
accounts := ListModel new!
owner
"Answer the owner of the receiver"
^owner!
owner: aString
"Set the owner of the receiver to aString"
owner := aString!
printOn: aStream
"Append, to aStream, a String whose characters are a description of the receiver as a developer
"Answer a <collection> of <ResourceIdentifier>s identifying all the resources managed by the receiver
that reference the specified <Object>."
^self allResourceIdentifiers select: [:each | each resource refersTo: anObject]! !
SmalltalkSystem comment:
'SmalltalkSystem is a Facade onto the Dolphin Smalltalk development environment. Most of the development tools hold the Singleton instance of SmalltalkSystem as their model and use it to act as a go-between between programmer, user interface, and the development image.
Instance Variables:
classHierarchyModel <ClassHierarchyModel> representing the hierarchy of classes in the system.
unsued <UndefinedObject> reserved for future use.
isOAD <boolean> indicating whether the system is configured for Object Arts development use.
systemFolder <treeModel> holding the contents of the System Folder.
Class Variables:
RegisteredTools <Set>
Current <SmalltalkSystem>
'!
!SmalltalkSystem class methodsFor!
current
"Answer the singleton instance of the receiver.
N.B. Special boot handling to create this."
Current isNil ifTrue: [Current := self basicNew initialize; yourself].
^Current!
help: educationPage
"Displays the education page specified by the <readableString> educationPage"
self current openEducationTopic: educationPage!
icon
"Answers an Icon that can be used to represent this class"
^Icon fromId: '!!APPLICATION'
!
new
"Private - The receiver is a Singleton class; use #current"
self shouldNotImplement!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
"Browse all the methods which belong to aCategoryOrString."
| cat methods name |
name := aCategoryOrString asString.
cat := Object methodCategoryClass name: name.
methods := cat contents.
methods isEmpty ifTrue: [^MessageBox notify: 'There are no methods in the ''', name, ''' category.'].
methods size > 200 ifTrue: [
(MessageBox confirm: ('The method category ''%1'' contains %2!!d!! methods.%nAre you sure you would like to browse it?' formatWith: name with: methods size))
ifFalse: [^self]].
self
browseMethods: cat contents
caption: 'Methods in ', cat displayString
findString: nil
filter: [:m | m categories identityIncludes: cat]!
browseMethodHierarchy: aCompiledMethod
"Open a new hierarchy browser on aCompiledMethod."
^(self hierarchyBrowserClass show)
selectMethod: aCompiledMethod;
yourself!
browseMethodHierarchyFrom: aCompiledMethod
"Opens a MethodBrowser on all the overidden methods in the superclass chain for aCompiledMethod"
"Compresses the current changes file and transfers all source to the sources (.sml)
file."
((MessageBox new)
yesNo;
defaultButton: 2;
caption: 'Compress Sources...';
warning: 'Compressing sources compacts the change log into the source (.sml) file. After compaction all record of what has changed will be lost and the change log will be empty.
Compressing sources is useful when you want to consolidate your work into a a new baseline image, but should otherwise be avoided.
confirmOrCancel: ('%1 is part of the implementation of the protocol %2 in %3 and/or its subclasses.%n
Are you sure that you would like to remove %1 from the protocol %4 as well as from the class?%n
Press Yes to remove the method from the %3, and its selector from the protocol %2. %3 will still conform to the reduced protocol %4, but contracting protocols can affect other conforming classes or the users of those classes.%n
Press No to remove the method and the dependent protocol %2 from the %3 and subclasses. %3 will no longer conform to the protocol %4, which might affect the users of %3 or its subclasses. The protocol %4 will be unaffected.%n
It is recommended that you press Cancel to abort deletion unless you are absolutely sure.'
formatWith: sel printString
with: desc
with: method methodClass name
with: (plural ifTrue: ['s'] ifFalse: [''])).
response == #cancel ifTrue: [^self].
response == #yes
ifTrue: [prots do: [:p | p removeSelector: sel]]
ifFalse:
["Removing the selector from the class will remove protocols from the class and subclasses"
"Set the class of presenter to be used for workspace shells."
workspaceClass := toolClass! !
TreeModelAbstract comment:
'TreeModelAbstract is the abstract superclass for classes implementing the <treeModel> protocol. All of the manipulations that modify the underlying tree structure will trigger notification events such that Observers will be informed of the changes. The <treeModel> protocol defines the following events:
#treeChanged:
#item:addedInParent:
#item:movedToParent:
#item:removedFromParent:
#itemUpdated:'!
!TreeModelAbstract class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #itemUpdated:;
add: #treeChanged:;
yourself.
!
withRoots: aCollection
"Answer an instance of the receiver with the roots in the <Collection> argument."
^super new setRoots: aCollection! !
!TreeModelAbstract methodsFor!
add: leaf asChildOf: branch
"Adds the <Object>, leaf, to the receiver as a child of the <Object>,
branch. If branch is nil then leaf is added as a root of the tree.
Answer leaf, or the existing leaf if already present."
^self subclassResponsibility!
addRoot: anObject
^self add: anObject asChildOf: nil!
allParentsOf: anObject
"Answer the an OrderedCollection of all the parents of anObject
within the hierarchy managed by the receiver. The collection is
ordered oldest ancestor first (i.e. the immediate parent is last).
If anObject is a root of the hierarchy then answer an empty collection.
If anObject does not exist in the receiver then raise a suitable exception."
| parent |
parent := self parentOf: anObject.
^parent isNil
ifTrue: [OrderedCollection new: 16]
ifFalse:
[(self allParentsOf: parent)
add: parent;
yourself]!
approxSize
"Private - Answer the approximate size of the receiver.
Implementation Note: This does not have to be accurate, but it should be fast
(i.e. don't calculate it by counting the receiver's elements).
The default is to guess at 2. Subclasses which can give a more
accurate size quickly will get better conversion performance."
^2!
asArray
"Answer an Array whose elements are those of the receiver.
(ordering is that of the #do: operation as implemented by the receiver)."
| anArray i |
anArray := Array new: self size.
i := 1.
self do: [ :e |
anArray basicAt: i put: e.
i := i + 1].
^anArray!
asBag
"Answer a Bag whose elements are those stored in the receiver"
^(Bag new: self size)
addAll: self;
yourself
!
asOrderedCollection
"Answer an <OrderedCollection> whose elements are those of the receiver
(ordering is that of the #do: operation as implemented by the receiver).
Implementation Note: Avoid OrderedCollection>>addAll:, because
it sends (indirectly) #size, which is slow to calculate."
| answer |
answer := OrderedCollection new: self approxSize.
self do: [:each | answer addLast: each].
^answer!
asSet
"Answer a Set whose elements are those stored in the receiver (any duplicates are therefore
eliminated)."
^(Set new: self approxSize)
addAll: self;
yourself
!
asSortedCollection
"Answer a SortedCollection whose elements are those of the receiver, sorted so that each
element is less than or equal to (<=) its successors. The elements must understand #<=."
^(SortedCollection new: self approxSize)
addAll: self;
yourself
!
asSortedCollection: discriminator
"Answer a SortedCollection whose elements are those of the receiver, sorted according to
the argument dynadic valuable argument, discriminator.
Note: The discriminator does not need to be a BlockClosure, it must simply
understand the #value:value: message from the dyadic valuable protocol."
^(SortedCollection new: self approxSize)
sortBlock: discriminator;
addAll: self;
yourself
!
basicRoots: aCollection
"Private - Set the roots of the receiver's hierarchy to be
the elements of the <collection> argument, added in that
collections #do: order."
^self subclassResponsibility!
childrenOf: anObject
"Answer an <OrderedCollection> of the children of anObject within
the hierarchy managed by the receiver. If anObject is nil then answer
the roots. If anObject does not exist in the receiver then raise a suitable
exception."
^anObject isNil
ifTrue: [self roots]
ifFalse: [self getChildrenOf: anObject]!
clear
"Clear the receiver (remove all nodes)."
^self subclassResponsibility!
collapse: anObject
"Removes the sub-trees beneath anObject in the receiver. If anObject does not exist
"Removes anObject from the receiver. If anObject does not exist
in the tree then answer the result of evaluating the <niladicValuable>,
exceptionHandler, otherwise answer anObject."
^self subclassResponsibility!
removeAll
"Removes all the objects in the receiver. A synonym for #clear"
self clear
!
reset
"Private - Reinitialize the receiver."
^self!
roots
"Answer the roots of the receiver's hierarchy."
^self subclassResponsibility
!
roots: aCollection
"Set the roots of the receiver's hierarchy to aCollection"
self reset.
self basicRoots: aCollection.
self trigger: #treeChanged: with: nil.!
searchPolicy
"Answer the <searchPolicy> used to compare and search for elements by the receiver."
^SearchPolicy identity!
setRoots: aCollection
"Private - Initialize the receiver with the roots in the <Collection> argument."
self initialize.
self basicRoots: aCollection!
size
"Answer the number of elements in the receiver.
Implementation Note: This implementation is rather inefficient,
and subclasses will probably want to override it."
^self countElements!
withAllChildren: anObject
"Answer an <OrderedCollection> containing the <Object> argument
(which must be in the tree represented by the receiver) and all of the
children of that object in this tree."
| children |
children := OrderedCollection new: 64.
children add: anObject.
(self childrenOf: anObject) do: [:each |
children addAll: (self withAllChildren: each) ].
^children!
withAllParents: anObject
"Answer an <OrderedCollection> containing the <Object> argument
(which must be in the tree represented by the receiver) and all of the
parents of that object in this tree."
| parents |
parents := OrderedCollection new: 64.
parents add: anObject.
parents addAll: (self allParentsOf: anObject).
^parents! !
ValueModel comment:
'ValueModel is an abstract class whose subclasses provide the capability to adapt the protocol of a subject object to a simple <value> protocol. The intention is to allow general purpose objects, such as <views>, to interact with more specific objects, by providing an adapted layer between them. A client of a <valueModel> can set the value of the subject using a #value: message and similarly the value can be retrieved by sending #value:.
An additional benefit is that <valueModel>s trigger a #value change notification whenever the value is modified. This allows <valueModel>s to share data with several observers following the standard Observer pattern. All <valueModel>s hold a <ComparisonPolicy> which determines when to trigger an update notification that the value has changed. By default, a change is notified when an attempt is made to set the value to a new one which is not equal to the existing value.
The most commonly used subclass of ValueModel is ValueHolder whose instances wrap a subject object and use this as the value.
Instance Variables:
comparisonPolicy <ComparisonPolicy> for determining whether a new value is different from the existing value
'!
!ValueModel class methodsFor!
comparisonPolicy: aComparisonPolicy
"Answer a new instance of the receiver with the specified comparison
policy and a 'nil' initial value."
^(self new)
comparisonPolicy: aComparisonPolicy;
yourself!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
publishedAspectsOfInstances
"Answer a <LookupTable> of the <Aspect>s published by instances of the receiver."
^(super publishedAspectsOfInstances)
add: (Aspect name: #value);
yourself!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
'TreeModel implements the <treeModel> protocol and organises a collection of objects into a tree like data structure. The tree is built of a hierarchy of <TreeNodes>. Objects can be added to the tree using #add:asChildOf: and they can be removed using #remove:. An object already in the tree can be moved from one location in the hierarchy to another by using the #move:asChildOf: message. Root nodes in the tree can be considered as having a parent of nil.
Instance Variables:
anchorNode <TreeNode> or nil, representing the root of the tree.
objectNodeMap <IdentityDictionary> mapping tree objects to <TreeNodes>
'!
!TreeModel class methodsFor!
defaultSearchPolicy
"Answer the default <searchPolicy> used by instances of the receiver."
^SearchPolicy identity!
new
"Answer a new empty instance of the receiver with the
default search policy."
^self withRoots: #()!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #item:movedToParent:;
add: #item:removedFromParent:;
add: #item:addedInParent:;
yourself.
!
stbConvertFrom: anSTBClassFormat
"Convert from earlier version models.
1:See Model
2: Added 'searchPolicy' instance variable."
^[:data | | newInst |
newInst := self basicNew.
newInst searchPolicy: self defaultSearchPolicy.
data keysAndValuesDo: [:i :v | newInst instVarAt: i put: v].
newInst]!
stbVersion
^2!
withRoots: aCollection
"Answer an instance of the receiver with the roots in aCollection"
"Private - Reset the receiver (remove all nodes)."
anchorNode := self newNode: nil.
objectNodeMap := searchPolicy newLookupTable!
rootNodes
^self childrenOfNode: anchorNode!
roots
"Answer the roots of the receiver's hierarchy.
Note that the roots of the tree must always be available."
^self rootNodes collect: [:each | each object]!
searchPolicy
"Answer the <searchPolicy> used to compare and search for elements by the receiver."
^searchPolicy!
searchPolicy: aSearchPolicy
"Private - N.B. The searchPolicy cannot be changed after a tree has been created.
This method is only for use during STB conversion of old instances."
searchPolicy := aSearchPolicy!
setRoots: aCollection searchPolicy: aSearchPolicy
"Private - Initialize the receiver with the roots in the <Collection> argument and
the specified <SearchPolicy>."
searchPolicy := aSearchPolicy.
self setRoots: aCollection!
size
"Answer the number of elements in the receiver"
^objectNodeMap size! !
VirtualTreeModel comment:
'VirtualTreeModel provides an <treeModel> interface onto a tree like data structure where the elements in the tree are always aware of their position in the hierarchy. In general, Smalltalk Collections organise objects into groups, but the objects are unaware of their grouping. In this way an object can belong to more than one Collection at a time. For a tree that follows this behaviour use a <TreeModel>. However, some objects are implicitly aware of their location within a tree hierarchy (e.g. Smalltalk classes); in such cases a VirtualTreeModel can be used to represent the structure without having to duplicate it as a hierarchy of <TreeNode>s.
VirtualTreeModel triggers the same modification events as a standard <treeModel>. However, the methods #add:asChildOf:, #move:asChildOf: and #remove: are only used to inform the tree model of changes that have been made externally to its structure. They do not actually modify the structure, though, since the VirtualTreeModel cannot be considered as owning it elements; they simply trigger the appropriate change notifications to inform the tree''s Observers.
The virtual tree is represented by a collection of objects that are the root of the hierarchy. Navigation around the tree is specifying by three monadic valuables; the getChildrenBlock, the getParentBlock and the hasChildrenBlock. A monadic filter valuable can also be specified to determine which of the objects in the actual hierarchy will appear in the virtual tree, though by default all objects are included.
A VirtualTreeModel tree is configured by supplying a number of root objects using the #roots aspect and also by setting number of <monadicValuable> (usually blocks) to define the structure. The following aspects are used to do this:
#getChildrenBlock : which answers a <sequencedCollection> of children for an object in the tree.
#hasChildrenBlock : which answers a <boolean> to quickly identify whether an object has any children.
#getParentBlock : which answer the parent of an object, or nil if it is one of the roots.
Instance Variables:
roots <OrderedCollection> of root objects.
getChildrenBlock <monadicValuable> used to identify the children of anobject in the tree.
getParentBlock <monadicValuable> used to identify the parent of an object in the tree.
hasChildrenBlock <monadicValuable> used to determine whether an object has children.
filter <monadicValuable> used to determine whether a object should be treated as part of the tree.'!
!VirtualTreeModel class methodsFor!
new
"Answer an instance of the receiver; instances must be initialized"
^self withRoots: OrderedCollection new!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #item:movedToParent:;
add: #treeChanged:;
add: #item:removedFromParent:;
add: #item:addedInParent:;
yourself.
! !
!VirtualTreeModel methodsFor!
add: anObject asChildOf: aParentObject
"Pseudo-adds anObject to the receiver as a child of aParentObject.
Since the tree is managed externally to the receiver we just
inform our dependents of the change. Answer anObject"
"Note that we must add the root, regardless of whether it passes the filter, as it
"Set the contents of the receiver to be the <Collection>, of <Category>s in list"
self clear.
"Add a title node if there is one"
title notNil ifTrue: [self addRoot: title].
(list asSortedCollection: [:a :b | a name < b name])
do: [:each | self addCategory: each]!
title
"Answer the top most node in the tree."
^title!
title: category
"Set the topmost node of the tree to be the specified <Category>"
title := category! !
ExpandingTreeModel comment:
'ExpandingTreeModel is a specialized <TreeModel> that dynamically generates the set of child nodes for a node, but only on first request. The tree is still built with a hierarchy of <TreeNodes>, but starts off only with the roots. As the user navigates through the tree (actually as the client view requests them) the tree is fleshed out.
See also VirtualTreeModel, which is a fully dynamic tree model.
Instance Variables:
getChildrenBlock <monadicValuable> used to identify the children of an object in the tree.
'!
!ExpandingTreeModel methodsFor!
approxSize
"Private - Answer the approximate size of the receiver.
Implementation Note: This does not have to be accurate, but it should be fast
(i.e. don't calculate it by counting the receiver's elements)."
^50!
childrenOfNode: node
"Private - Answer an <OrderedCollection> of the child nodes of the <TreeNode>, node."
| children |
(children := node getChildren) isNil
ifTrue:
[self expandNodeChildren: node.
children := node children].
^children!
defaultGetChildrenBlock
^Message selector: #children!
expandNodeChildren: aTreeNode
"Private - Dynamically expand the <ExpandingTreeNode>, node, to populate it
with its children. Answer an <OrderedCollection> of <TreeNode> containing the
children. Note that because TreeNode stores nil instead of an empty
collection (to save space), each access to the children of a leaf node will
required a further attempt at expanding the children. This has an upside, in that
a connected tree view will update to display an expansion button when/if a former
leaf acquires children."
(self getChildrenOfNode: aTreeNode)
do: [:each | self add: each asChildOfNode: aTreeNode]!
getChildrenBlock
"Answer the <monadicValuable> which when evaluated answers a <sequencedReadableCollection>
of the children of its argument."
^getChildrenBlock!
getChildrenBlock: monad
"Set the <monadicValuable> which when evaluated answers a <sequencedReadableCollection>
of the children of its argument."
getChildrenBlock := monad!
getChildrenOfNode: aTreeNode
"Private - Answer an <OrderedCollection> of <TreeNode>s, being the calculated collection
of children of the specified parent node."
^self getChildrenBlock value: aTreeNode object!
hasChildren: anObject
"Answer true if anObject has children within the hierarchy managed by the
receiver. If anObject does not exist in the receiver then raise a suitable
"If the hasChildrenBlock is nil (the default) then the tree determines whether there are
any children by expanding them using the getChildrenBlock (i.e. they will be retained)."
hasChildrenBlock := aMonadicValuableOrNil!
initialize
"Private - Initialize the receiver"
getChildrenBlock := self defaultGetChildrenBlock.
super initialize.
!
roots
"Answer the roots of the receiver's hierarchy.
Implementation Note: Override because we don't want to apply the getChildrenBlock
against the anchor node if it is empty."
^anchorNode children collect: [:each | each object]! !
FolderHierarchyModel comment:
'FolderHierarchyModel is a specialized <TreeModel> that holds a directory hierarchy, with nodes representing each directory/folder in the hierarchy. The nodes are maintained in sorted order.
'!
!FolderHierarchyModel class methodsFor!
defaultSearchPolicy
^SearchPolicy equality! !
!FolderHierarchyModel methodsFor!
addFolder: aString
"Add the hierarchy of folders in the <readableString> path argument to the receiver."
| parent newFolder |
newFolder := self folderClass pathname: aString.
(aString isEmpty or: [File isRootPath: aString])
ifFalse:
[parent := newFolder parent.
self addFolder: parent pathname].
self add: newFolder asChildOf: parent!
folderClass
^Folder!
newNode: anObject
^(super newNode: anObject)
children: (SortedCollection sortBlock: [:x :y | x object <= y object]);
yourself! !
PackageHierarchyModel comment:
'PackageHierarchyModel is a <FolderHierarchyModel> specialized to represent the hierarchy of folders of installed packages.
'!
!PackageHierarchyModel methodsFor!
addPackage: aPackage
"Private - Add a the hierarchy of folders leading to the specified <Package> to the receiver."
'RegTreeModel implements a <treeModel> representing the hierarchy of <RegKey>s in the Windows system registry. For an example of its use, see the RegEdit sample application.'!
!RegTreeModel methodsFor!
approxSize
"Private - Answer the approximate size of the receiver.
Implementation Note: This does not have to be accurate, but it should be fast
(i.e. don't calculate it by counting the receiver's elements)."
^5000!
searchPolicy
"Answer the <searchPolicy> used to compare and search for elements by the receiver.
Implementation Note: As we are fronting an externally represented tree (i.e
the Registry) the nodes are created to represent the external keys and values,
and are not, therefore, identical."
^SearchPolicy equality!
setRoots: aCollection
"Private - Initialize the receiver with the roots in aCollection"
"Deliberately omit super initialize"
getChildrenBlock := [:each | each asSortedCollection: [:a :b | a name < b name]].
getParentBlock := Message selector: #parentKey.
hasChildrenBlock := Message selector: #notEmpty.
self basicRoots: aCollection! !
ViewHierarchyModel comment:
'ViewHierarchyModel implements a <treeModel> representing the hierarchy (or a subset of it) of open <views> in the system.'!
!ViewHierarchyModel class methodsFor!
withAllViews
"Answer an instance of the receiver on the entire view hiearchy"
^self withRoots: (Array with: View desktop)! !
!ViewHierarchyModel methodsFor!
setRoots: aCollection
"Private - Initialize the receiver with the roots in aCollection"
'An abstract class whose subclasses allow some part of a subject object (typically an aspect or keyed element) to be treated a <valueModel>.
Instance Variables
subject <Object> whose content will be adapted to be accessed as a <value>'!
!ValueAdaptor class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
!ValueAdaptor methodsFor!
printOn: aStream
"Append a short textual description of the receiver to, aStream."
aStream
basicPrint: self;
nextPut: $(; display: self; nextPut: $)
!
subject
"Private - Answers the subject model for the receiver"
^subject
!
subject: anObject
"Private - Sets the subject object"
subject := anObject.
! !
ValueConverter comment:
'A ValueConverter sits between a subject <valueModel> and some <value> client of this. It supports the <valueModel> protocol such that when the client attempts to get the subject value it is converted into another type of object that is more palatable to the client. Similarly when the client tries to put a value back into the subject the type can again be converted, this time to suit the subject''s needs.
An assumption is made that the subject will be a <valueModel> and will therefore trigger its own #value events when it is updated. A ValueConverter simply forwards this event to any of its own clients.
Instance Variables:
subject <valueModel> subject.
typeConverter <typeConverter> for mapping the subject value to another type.
'!
!ValueConverter class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Private - An instance of this class requires parameters, use: #subject:typeConverter"
^self shouldNotImplement!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
'A ValueHolder wraps an object and notifies its dependants when that object is replaced. Since ValueHolders are commonly used, there is a short cut available for creating them. Sending #asValue to any object will answer that object wrapped inside a ValueHolder.
Instance Variables:
value <Object> which is the value held by the receiver.
'!
!ValueHolder class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
with: anObject
"Answers an instance of the receiver holding anObject as its value"
^(self new) setValue: anObject; yourself! !
!ValueHolder methodsFor!
setValue: anObject
"Private - Assigns the value for the receiver without notifying
dependents of the change"
value := anObject!
value
"Answers the value of the receiver"
^value! !
AspectAccessor comment:
'Part of the PublishedAspectInspector framework. This is a <ValueAspectAdaptor> on a particular aspect of an object. It also holds an <Aspect> that describes the aspect so that sufficient information is available to be able to display or edit it within a presenter UI. An AspectAccessor instance is also capable of knowing it''s "parent" accessor. This allows instances to be manipulated by an <AspectAccessorTreeModel>.
Instance Variables:
aspectDescriptor <Aspect> the descriptor for the aspect being accessed.
parentAccessor <AspectAccessor> the parent accessor or nil.
'!
!AspectAccessor class methodsFor!
new
"Private - An instance of this class requires parameters"
^self shouldNotImplement!
subject: anObject aspect: anAspect
"Answers an instance of the receiver that is an interface onto
aAspect of anObject"
^(super new)
setSubject: anObject aspectDescriptor: anAspect;
yourself! !
!AspectAccessor methodsFor!
<= anAspectAccessor
"Answer whether the receiver is 'less than' anAspectAccessor.
By implementing this method, we enable AspectAccessor objects to be stored
in a SortedCollection with the default sort block."
If an exception is raised attempting to access the value, then answer that instead."
^self aspectDescriptor readFrom: self subject!
valueIcon
^self value icon!
yourselfAspect
"Answers the AspectAccessor for the #yourself published aspect of the
receiver's value."
^self value publishedAspects detect: [:each | each name == #yourself]! !
ValueAspectAdaptor comment:
'A ValueAspectAdaptor is capable of adapting an aspect of a subject object and treating this as a <value>. An aspect is considered to be an attribute of an object that can be fetched and set using a pair of accessor methods (aspect and aspect: say).
ValueAspectAdaptors are typically used in two situations. The first is to adapt an aspect of a model to the generic <value> protocol of #value, #value: messages. This is a common requirement of <dialogPresenter>s which need to present multiple aspects of a model within their sub-presenters. The second is to allow aspects of a domain class which does not generate change notifications to be used in situations that require them.
Instance Variables:
aspect <Symbol> identifying the aspect
putSelector <Symbol> message selector used to set the aspect
getSelector <Symbol> message selector used to get the aspect
'!
!ValueAspectAdaptor class methodsFor!
new
"Private - An instance of this class requires parameters"
^self shouldNotImplement!
subject: anObject aspect: aSymbol
"Answers an instance of the receiver that is an interface onto
"Private - Sets the subject object and its aspect that is being interfaced
to by the receiver"
super subject: anObject.
aspect := aSymbol.
getSelector := aspect.
putSelector := (aspect , ':') asSymbol.
!
value
"Answers the <Object> value of the receiver, obtained
by sending a message to the receiver's subject."
^self getValue! !
ValueKeyedAdaptor comment:
'A ValueKeyedAdaptor is capable of adapting a keyed element of a subject object (typically a Collection) and treating this as a <value>. A keyed element one which can be accessed from the subject object using #at: and #at:put:.
Instance Variables:
key <Object> used as the key to access an element of the subject
putSelector <selector> message used to set the aspect
getSelector <selector> message used to get the aspect
'!
!ValueKeyedAdaptor class methodsFor!
new
"Private - An instance of this class requires parameters"
^self shouldNotImplement!
subject: anObject key: aKey
"Answers an instance of the receiver that is an interface onto
"Private - Answer the <BatchAspectAccessor> that will follow the receiver or nil if there is none"
| nextKey |
nextKey := self startKey + self batchSize.
^(self subjectIncludesKey: nextKey)
ifTrue:
[self class
subject: self subject
keys: self keys
startingAt: nextKey
batchSize: self batchSize]!
selectIn: anInspector
anInspector expandBatchAccessor: self!
startKey
"Private - Answers the index of the key used to access the first element of the subject that
the receiver is to treat as a value"
^self aspectDescriptor key!
subjectIncludesKey: nextKey
^nextKey <= self keys size!
value
"Answers the <Object> value of the receiver, obtained by
sending a message to the receiver's subject with the key."
^nil!
valueIcon
^self icon! !
IndexedInstVarBatchAccessor comment:
'Part of the InstVarInspector framework. IndexedInstVarBatchAccessors are used to give access to a group of <IndexedInstVarAccessors> for indexed slots of an object. Batching the accessors up in this way allows the InstVarInspector to only display a certain number of elements at a time. This can substantially improve performance when displaying large indexed objects.'!
!IndexedInstVarBatchAccessor class methodsFor!
subject: anObject batchSize: sizeInteger
"Answers an instance of the receiver that is an interface onto a range of
keyed elements of the subject <Object>, anObject."
^self
subject: anObject
keys: (1 to: anObject basicSize)
startingAt: 1
batchSize: sizeInteger! !
!IndexedInstVarBatchAccessor methodsFor!
aspectClass
^InstVarAspect!
getBatchAccessors
"Answer an <OrderedCollection> of the IndexedInstVarAccessors represented by the receiver"
'Part of the PublishedAspectorInspector framework. KeyedAspectBatchAccessors are used to give access to a group of <KeyedAspectAccessors> for elements of a keyed collection. Batching the accessors up in this way allows the PAI to only display a certain number of elements at a time. This can substantially improve performance when displaying large (or slow to access) collections.'!
!KeyedAspectBatchAccessor class methodsFor!
subject: anObject batchSize: sizeInteger
"Answers an instance of the receiver that is an interface onto a range of
keyed elements of the subject <Object>, anObject."
^self
subject: anObject
keys: anObject keys
startingAt: 1
batchSize: sizeInteger! !
!KeyedAspectBatchAccessor methodsFor!
aspectClass
^KeyedAspect!
getBatchAccessors
"Answer an <OrderedCollection> of the <AspectAccessors> on the batch of
<KeyedAspect>s represented by the receiver"
| accessors absentCookie start end subj keys |
start := self startKey.
keys := self keys.
end := start + self batchSize - 1 min: keys size.
accessors := OrderedCollection new: end - start + 1.
"Answer a <LookupTable> of the <Aspect>s published by the receiver.
Implementation Note: Prevent the PublishedAspectInspector from displaying any sub-aspects
for this node (without this one gets a + and can expand it)."
^LookupTable new! !
ValueBuffer comment:
'A ValueBuffer can be used to buffer changes to a subject <valueModel>. It presents the same <value> protocol as its subject but, when the value is changed, the change is not immediately passed to the subject. This only happens when the ValueBuffer receives an #apply message to indicate that any changes should flushed.
It is important to note that, in order to be used with a ValueBuffer
Instance Variables:
subject <valueModel> being buffered.
modified <boolean> indicating whether the subject has been modified.
gate <valueModel> which, when set true will apply changes back to the subject.
'!
!ValueBuffer class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
new
"Private - Use #subject:"
^self shouldNotImplement!
subject: aSubjectValueModel
"Answer an instance of the receiver that buffers the value of aSubjectValueModel"
^super new subject: aSubjectValueModel
! !
!ValueBuffer methodsFor!
apply
"Apply any buffered changes back to the subject"
modified ifTrue: [
subject value: self value.
modified := false. ]!
gate
"Answer the gate value model that controls when (and if) changes will be
flushed back to the original model."
^gate!
gate: aValueModelGate
"Set the gate model to be aValueModelGate. Changes will be flushed back to
the original model when the value of aValueModelGate is set
to true."
gate := aValueModelGate.
gate when: #valueChanged send: #onGateChanged to: self.!
isValid
"Answer true if the updates to the model are valid. Provided
for protocol compatibility with AspectBuffer"
^true!
onGateChanged
"Private - Received when the gate has been triggered.
Use this to either flush changes back to the subject if required"
self gate value ifTrue: [self apply]!
setValue: anObject
"Private - Assigns the value for the receiver without notifying
dependents of the change. The value is saved in the buffer and
not directed to the subject (yet)"
super setValue: anObject.
modified := true.!
subject: aSubjectValueModel
"Private - Initializes the receiver on aSubjectValueModel"
gate := false asValue.
subject := aSubjectValueModel.
modified := false!
value
"Answers the value of the receiver. If the value has been modified then
answer the buffered value otherwise answer that of the subject"
^modified ifTrue: [ super value ] ifFalse: [ subject value ].! !
PermanentRegistry comment:
'PermanentRegistry is a specialized class of <ObjectRegistry>s which maintain a strong reference to registered objects, preventing them from being garbage collected. They are useful where the objects may only be referenced ''externally'' (e.g. COM server objects).
The superclass instance variable ''registry'' is initialized to an <Array> in instances of this class. The slots of the array are populated either with registered objects, or linked onto a free list by index (the content of the slot being the next free entry). The last element of the <Array> is always zero to mark the end of the free list. When a new object is registered the first slot on the free list is used, unless there are no free slots in which case the array is resized to increase its capacity.
Note: The implementation of the free list in this class using integer indices means that PermanentRegistry instances are not suitable for registries of <Integer>s.
Instance Variables:
freeHead <integer> index of the first free slot in the registry.'!
!PermanentRegistry methodsFor!
addAnsweringIndex: anObject
"Register the argument, anObject, answering a unique SmallInteger id which can be used
'WeakRegistry comment: ''WeakRegistry is the class of <ObjectRegistry>s which maintain only a weak reference to registered objects. Thus registration in a WeakRegistry will not prevent the registrant from being garbage collected, which makes it useful where a unique identifier is needed for an object only for as long as it is still referred to from elsewhere in the image. An example usage is the register of extant <ExternalCallback> objects.
The superclass instance variable ''''registry'''' is initialized to an <WeakArray> in instances of this class. The slots of the array are populated either with registered objects, or with the corpse object (i.e. the DeadObject singleton instance). When a new object is registered the first slot currently occuppied by a corpse is used, unless there are no ''''dead'''' entries, in which case the weak array is resized to increase its capacity. The integer key associated with a registered object is its index in the array.
'!
!WeakRegistry methodsFor!
addAnsweringIndex: anObject
"Register the argument, anObject, answering a unique SmallInteger id which can be used
subsequently to retrieve that object."
^registry addAnsweringIndex: anObject!
initialize: anInteger
"Private - Initialize the receiver with the specified initial capacity."
registry := WeakArray new: anInteger.
registry replaceFrom: 1 to: anInteger withObject: DeadObject current!
removeAtIndex: anInteger
"Remove, and answer, the registered object with id anInteger in the receiver.
Raise an error if there is no element indexed by anInteger."
'A RegularPolygon describes a particular type of <PlayShape> that may be added to a <Playground>. It is part of the Playground sample package used as a Smalltalk learning aid. See this package''s comment for more details.
A RegularPolygon has a number of sides and is drawn within a bounding circle of a given radius and centre position. The polygon, when drawn, is filled with a particular background color. This information is held in the instance variables of a RegularPolygon instance.
Instance Variables:
color <color> used to fill the polygon.
sides <integer> number of sides.
position <Point> position of the polygon centre within the playground.
rotation <number> of degrees by which the polygon is rotated.
radius <number> of pixels radius to the boundary of the polygon.
'!
!RegularPolygon class methodsFor!
new
"Create an instance of the receiver with a default number of sides"
^super new initialize! !
!RegularPolygon methodsFor!
chooseColor
"Open a color picking dialog on the receiver to allow the color to be changed"
"Set the rotation of the receiver to be aNumberOfDegrees
and ask for it to be redrawn."
rotation := aNumberOfDegrees.
self redraw.!
shrinkBy: aNumberOfUnits
"Shrink the receiver by aNumberOfUnits and cause it to be redrawn"
self growBy: aNumberOfUnits negated!
sides
"Answer the number of sides that the receiver has. This is set when
the receiver is created and should not be subsequently changed."
^sides!
sides: anInteger
"Set the number of sides of the receiver and cause it to be redrawn"
sides := anInteger.
self redraw.
! !
Circle comment:
'A Circle is a particular type of <PlayShape> that may be added to a <Playground>. It is part of the Playground sample package used as a Smalltalk learning aid. See this package''s comment for more details.'!
!Circle methodsFor!
defaultColor
"Answer a default background color for the receiver.
Let's make Circles blue to start with."
^Color blue!
defaultPosition
"Answer a default position for the centre of the receiver. This may be overidden
by subclasses that wish to start off at another location"
^100 @ 200!
defaultSides
"Answer a default number of sides for the receiver.
Circles effectively have many sides"
^100! !
Square comment:
'A Square is a particular type of <PlayShape> that may be added to a <Playground>. It is part of the Playground sample package used as a Smalltalk learning aid. See this package''s comment for more details.'!
!Square methodsFor!
defaultColor
"Answer a default background color for the receiver.
Let's make Squares red to start with."
^Color red!
defaultPosition
"Answer a default position for the centre of the receiver. This may be overidden
by subclasses that wish to start off at another location"
^200 @ 100! !
Triangle comment:
'A Triangle is a particular type of <PlayShape> that may be added to a <Playground>. It is part of the Playground sample package used as a Smalltalk learning aid. See this package''s comment for more details.'!
!Triangle methodsFor!
defaultColor
"Answer a default background color for the receiver.
Let's make Trangles yellow to start with."
^Color yellow!
defaultPosition
"Answer a default position for the centre of the receiver."
^200 @ 200!
defaultSides
"Answer a default number of sides for the receiver.
Triangles have 3 sides"
^3! !
ClassBrowserPluginAbstract comment:
'<ClassBrowserPluginAbstract> is the abstract superclass that implements the basic <classBrowserPlugin> protocol to support plug-in views for class browsers. The plug-ins are appended to the standard set of tabbed cards in the lower half of the browser and can be displayed by selecting the appropriate tab. Each browser class maintains an <OrderedCollection> of plug-ins that will be installed when instances of the browser are created. This collection can be modified through the User Preferences for that browser.
When a plug-in is created it is assigned the class browser to which it is attached as its model. From this, the plug-in can observe events in the browser (such as #classSelected, #methodSelected, #packageSelected etc) and use these to initiate the rendition of its own display. In situations where creating this rendition may be a time consuming process, the plug-in may choose to defer this step until its card is actually made visible in the browser. This can be intercepted by overriding #onShownInBrowser.'!
!ClassBrowserPluginAbstract methodsFor!
browser
^self model!
createSchematicWiring
"Create the trigger wiring for the receiver"
super createSchematicWiring.
self model cardsPresenter view when: #currentCardChanged send: #onBrowserCardChanged to: self.
!
isCurrentCard
"Answer true if the receiver is the current card shown in the browser"
"Event handler indicating that the receiver has been displayed within it's browser.
Overridden by subclasses to perform just-in-time rendering of the receiver's contents."! !
EtchASketch comment:
'EtchASketch is a <compositePresenter> component that emulates the popular Etch-a-Sketch toy. It allows "ink" to be drawn onto a sketch pad by means of two "knobs"; one for horizontal movement and one for vertical movement. In the basic view the knobs are represented by scroll bars. EtchASketch makes use of the Scribble component for its sketch area.
There are a couple of limitations that make this example not ideal:
1/ It is not possible (with the Windows interface) to move both "knobs" simultaneously. This means that it is not possible to draw diagonal lines.
2/ A new InkStroke object is added for each incremental movement of a "knob". This is relatively inefficient, since a scrollbar will create many events as it is moved, resulting in many InkStrokes being created. A more sophisticated approach would be to coalesce the consequetive movements of a knob into one stroke. This is left as an exercise for the reader.
Example:
EtchASketch show.
See the package comment for further examples of use.
Instance Variables:
upDownKnob <NumberPresenter> for the vertical drawing "knob".
leftRightKnob <NumberPresenter> for the horizontal drawing "knob".
sketchPad <Scribble> displaying the picture.
lastLocation <Point> holding the last location drawn to.
'!
!EtchASketch class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^ListModel new!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Private - Initialize the receiver's class variables
upDownKnob := self add: NumberPresenter new name: 'upDownKnob'.
leftRightKnob := self add: NumberPresenter new name: 'leftRightKnob'.
sketchPad := self add: Scribble new name: 'sketchPad'.
!
createSchematicWiring
"Create the trigger wiring for the receiver"
super createSchematicWiring.
leftRightKnob when: #valueChanged send: #onKnobChanged to: self.
upDownKnob when: #valueChanged send: #onKnobChanged to: self.
!
initialize
"Private - Initialize the receiver"
super initialize.
lastLocation := 0@0.!
model: aListModel
"Connects the receiver to aListModel. Since the receiver has the same model as the
sketch pad (Scribble) component that it holds we pass this down to it."
super model: aListModel.
sketchPad model: aListModel.!
onKnobChanged
"Private - Once of the knobs has been moved. Draw to the correct location in the sketch pad"
| newLocation inkStroke scale |
"Find the location indicated by the current state of the knobs. Their range is 0-100%
so scale this to the extent of the sketch pad view"
scale := sketchPad view extent / 100.
newLocation := ((leftRightKnob value @ upDownKnob value) * scale) truncated.
"Create an InkStroke representing this movement from the last known location.
Add this to the model."
inkStroke := InkStroke new
addPoint: lastLocation;
addPoint: newLocation;
yourself.
self model add: inkStroke.
"Remember the current location as the last"
lastLocation := newLocation.! !
PackagePrerequisites comment:
'PackagePrerequisitesShell is a <SmalltalkSystemTool> that displays a package pre-requisite hierarchy, rooted in the immedaite pre-requisites of a particular <Package>. For each prerequisite the list of all the links from the package to the prerequisite are listed. Each link shows: the object belonging to the package, why it forced the prerequisite, and the object owned by the prerequisite which it relies upon. The links are generated and described within the Package>>tracePrerequisites method.
Instance Variables:
prerequisitesPresenter <TreePresenter> holding the dependency tree for a package.
tracesPresenter <ListPresenter> holding the list of traces.
traces <IdentityDictionary> of traces generated by Package>>tracePrerequisites.
package <Package> whose prerequisites are being displayed.
'!
!PackagePrerequisites class methodsFor!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Package Prerequisites'
!
icon
"Answers an Icon that can be used to represent this class"
^Package icon! !
!PackagePrerequisites methodsFor!
browsePackages
"Browse the currently selected prerequisite package."
'Scribble is a <presenter> component that displays a <listModel> of <InkStroke>s within a <ScribbleView>. It is used to for accepting ''ink'' as a series of mouse or pen strokes and populate the model with this data. Scribble is part of the Scribble sample package. For examples of use please see the package comment.'!
!Scribble class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^ListModel new!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Private - Initialize the receiver's class variables
"Private - Start ink tracking for the associated view at aPoint. Part of the
<MouseTracker> target protocol. Answers the actual position achieved."
"Draw some visual feedback"
trackingCanvas := self view canvas.
trackingCanvas moveTo: aPoint.
"Create a new stroke"
newStroke := InkStroke new.
^newStroke addPoint: aPoint.! !
SelectableItemsPresenter comment:
'SelectableItemsPresenter ia an abstract class that implements the <selectableItems> protocol for components that need to make one or more selections from multiple items held by their model. Typically the model will be either a <listModel> or <treeModel>.'!
!SelectableItemsPresenter class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^ListPresenter icon! !
!SelectableItemsPresenter methodsFor!
ensureSelectionVisible
"Ensure the selected item is visible, scrolling it into view if necessary.
Raise an error if there is no selection."
self selectableItems ensureSelectionVisible!
hasSelection
"Answer true if the receiver has a current selection"
^self selectableItems hasSelection!
onSelectionChanged
"Handler for a selection change in the receiver's view"
self selectableItems onSelectionChanged!
onSelectionChanging: aSelectionChangingEvent
"Handler to indicate that the receiver's selection is about to change.
To prevent the proposed change under certain circumstances a handler
'Shell implements the <topPresenter> protocol for presenters that are to appear in <topView>s; i.e. in top-level windows on the desktop.A Shell provides methods for supplying a caption for the associated <topView> and for maintaining a <HistoryList> of commands that have recently been performed within it. By default, a Shell will not maintain a command history unless it is explicitly told to do so using its #hasCommandHistory aspect. The purpose of maintaining a command history is to support the potential for #undo and #redo operations. For these to work successfully, each <Command> must be provided with an appropriate undo action after it has been performed. For more details see the comment for Command.
Instance Variables:
caption <readableString> or nil, holding and explicit caption for the associated <topView>.
commandHistory <HistoryList> or nil, holding a history of <Command>s that the presenter has recently performed.
'!
!Shell class methodsFor!
create: aResourceNameString
"Answers an instance of the receiver created with no parent presenter
and wired up to a view identified by the resource name aResourceNameString.
The view must be a Shell and will be a child of the desktop"
| newOne |
newOne := self new.
newOne createView: aResourceNameString.
^newOne!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
registerAsToolWith: aSmalltalkSystem
"The receiver is being registered as a tool with aSmalltalkSystem. Perform any
additional registration operations here. Part of the <installableSystemTool>
protocol, and implemented at this level so that 3.0 tools can be installed
without amendment."
!
unregisterAsToolWith: aSmalltalkSystem
"The receiver is being unregistered as a tool with aSmalltalkSystem. Perform any
additional unregistration operations here. Part of the <installableSystemTool>
protocol, and implemented at this level so that 3.0 tools can be installed
without amendment."
! !
!Shell methodsFor!
addCommandHistory: aCommand
"Private - Adds aCommand to the receiver's command history list.
Only do this if the command is undoable. If not then clear the list unless
the command has been marked as being benign."
self hasCommandHistory ifTrue: [
aCommand isBenign ifTrue: [^self].
aCommand canUndo
ifTrue: [ commandHistory addLast: aCommand ]
ifFalse: [ self clearCommandHistory ]]!
allAdditionalAccelerators
"Private - Answer a collection of additional accelerator definitions for commands not on the menu bar of the receiver's view(s),
but which either the receiver of one of its sub-presenters wants to define.
Each element of the collection should be a two element <Array>, the first element of which is the command symbol
"Mark the current command (#undo) as benign so that it will
not require the command history to be cleared even though it has no
explicit undo action"
Command current beBenign]!
updateCaption
"The receiver has changed in such a way that the caption may need to be refreshed.
Overidden in subclasses that need to provide a dynamic caption that changes
according to the state of the receiver"
!
updateIcon
"Private - Transfer any icon across to the view"
self view largeIcon isNil ifTrue: [
"Update the view's icon if not explicitly specified"
self view largeIcon: self icon ].
!
view: aShellView
"Set the view for the receiver to aShellView.
After this is complete we inform all our sub presenters that
everything is open and ready to go."
super view: aShellView.
self onViewOpened; setInitialFocus
! !
SmalltalkWorkspace comment:
'SmalltalkWorkspace is a <presenter> for displaying a workspace area within a <TextEdit> view. Note that, for efficiency purposes, a SmalltakWorkspacedoes not have a model. The textual data is held only within the associated <TextEdit> view. since there seems little point in duplicating this text and holding it within the image as, say, a <readableString>.
Instance Variables:
evaluationContext <Object> used as the "self" context for evaluations.
errorModel <valueModel> holding the first error notification from the last compilation.
findDetails <Array> specifying text search details.
workspacePool <PoolDictionary> holding local variables held by the workspace.
evaluationPools <Array> of <PoolDictionary>s for lookup pools during evaluations.
compilationErrors <OrderedCollection> of <CompilerNotification>s
Class Variables:
DefaultBackcolor <color> of the background to use.
WordWrap <boolean> indicating whether the workspace should word wrap text.
DefaultFont <Font> for source text
AdditionalAccelerators <Array> of 2-element <Array>s, being command <Symbol> accelerator key <String> pairs
"Private - Answer the current evaluation range, selecting the current
line and answering its entire range if there is no selection."
| te range |
te := self view.
range := te selectionRange.
range isEmpty
ifTrue: [range := te selectCurrentLine].
^range!
selection
"Answer the currently selected text in the receiver's source"
^self view selection!
selectionRange
"Answers an interval identifying the selected range of text.
N.B. The last entry in the selection is exclusive (this is the way
the underlying Windows controls identify an empty selection and
caret position with the same interval)."
^self view selectionRange!
selectionRange: anInterval
"Sets anInterval to be the selected range of text.
The last character in the interval is not included in
the actual selection."
^self view selectionRange: anInterval
!
selectLine: anInteger
"Selects the complete line of text in the receiver at
line number, anInteger. Line 1 is the first line of
text. A BoundsError will be generated if anInteger
is greater than the last line number in the receiver."
^self view selectLine: anInteger!
showError: aCompilerError offset: anInteger
self errorModel value isNil ifTrue: [aCompilerError beep].
self errorModel value: aCompilerError.
self selectionRange: aCompilerError range + anInteger!
showErrors: aSequenceableCollection
"Inform the receiver that the compilation which had the receiver
as the notifier for any errors has not ceased. Highlight any
errors that occurred."
| errors |
errors := self errorModel.
errors notNil
ifTrue:
[aSequenceableCollection isEmpty
ifTrue: [self clearErrors]
ifFalse:
[| first |
first := aSequenceableCollection
detect: [:each | each severityClass == Error]
ifNone: [aSequenceableCollection first].
self showError: first offset: 0]]!
showFirstError: anInteger
"Private - Display the first error, or warning, in the receiver's compilation errors collection,
which contains errors collected on the last compilation or evaluation. Answer
whether there are any errors."
| errors |
errors := self errorModel.
errors notNil
ifTrue:
[compilationErrors isEmpty
ifTrue: [errors value: nil]
ifFalse:
[| first |
first := compilationErrors detect: [:each | each severityClass == Error]
ifNone: [compilationErrors first].
self showError: first offset: anInteger]].
^compilationErrors notEmpty!
showResult: anObject at: caretPos
"Private - Show the result of an evaluation."
| result selStart |
self isOpen ifFalse: [^self].
result := anObject printString.
self view
caretPosition: caretPos;
resetCharFormat.
selStart := caretPos.
self replaceSelection: result.
self selectionRange: (selStart to: selStart + result size-1)!
snatchAbbreviation
| key text |
(text := self selection) isNil ifTrue: [^self].
((key := Prompter prompt: 'Desired abbreviation for this text?') notNil
and: [key notEmpty])
ifTrue:
[(key occurrencesOf: $:) > 0
ifTrue: [^MessageBox warning: 'Do not enter an abbreviation containing a colon.'].
self class abbreviations at: key put: text]!
syntaxColorOfExpression: aString
| context |
context := self evaluationContext.
^context class compilerClass
syntaxColorOfExpression: aString
in: context class
evaluationPools: self allPools!
systemModel
"Private - Answer the development system model."
^Smalltalk developmentSystem!
text
"Answer the receiver's text contents (may be plain or rich text
depending on the connected view). Access to source code in the
receiver is best achieved by sending #plainText."
^self view text!
text: aString
"Set the text in the receiver to aString"
^self view resetCharFormat; text: aString!
textLength
"Answer the number of characters in plain text of the receiver"
^self view textLength!
workspacePool
"Answer the PoolDictionary for locals used in evaluations within the receiver"
^workspacePool!
workspacePool: aPoolDictionaryOrNil
"Set the PoolDictionary for locals used in evaluations within the receiver"
workspacePool := aPoolDictionaryOrNil! !
ValuePresenter comment:
'ValuePresenter is a <valuePresenter>s that presents the contents of a <valueModel> within a <valueView>.
When designing a <presenter> it is necessary to make an initial decision as to how its model data should be displayed and edited. If the model is a mutable object, in that it is legal (and sensible) to modify it in place, then it is usual to treat it as a simple <presenter> and create a class descended directly from Presenter itself. If, on the other hand, the model is to be immutable then the presenter should be implemented as a <valuePresenter>. If the identity of the underlying model data must remain unchanged then use a standard <presenter>. If this is not the case then a <valuePresenter> will be more suitable.
In many cases a <valuePresenter> will be implemented as a subclass of ValuePresenter. However, this is not essential and instances of ValuePresenter can be created and use directly.
'!
!ValuePresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^nil asValue
!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #valueChanged;
yourself.
! !
!ValuePresenter methodsFor!
findDetails
"Required so can be used with a TextEdit view."
^nil!
model: anObject
"Set the model of the receiver to be a value model on anObject. Usually anObject is expected
to be a ValueModel itself. If not, it is automatically wrapped in a valueHolder.
Register with it's #valueChanged event"
| valueModel |
valueModel := anObject asValue.
super model: valueModel.
valueModel when: #valueChanged send: #onValueChanged to: self!
onValueChanged
"The value held by the receiver's model has changed.
The default is to trigger a #valueChanged event off the receiver"
self trigger: #valueChanged!
setValue: anObject
"Private - Set the model data of the receiver to be anObject but without propagating
"Set the model value of the receiver to be anObject"
self model value: anObject.
! !
ClassDiagramPlugin comment:
'ClassDiagramPlugin is a simple example of a <classBrowserPlugin> that renders the hierarchy below the browser''s currently selected class in a moen tree diagram. Although the time taken to perform this rendition is not significant, for illustrative purposes, we have chosen to defer the building of the class diagram until the plug-in''s card is selected in the browser.
Instance Variables:
classesPresenter <ClassHierarchySelector> used to show the class hierarchy diagram
'!
!ClassDiagramPlugin methodsFor!
buildClassDiagram
"Private - Create the diagram for the browser's currently selected class"
"Event handler indicating that the receiver has been displayed within it's browser. "
"For efficiency we defer the creation of the diagram until the receiver becomes the current card"
self buildClassDiagram! !
ClassSelector comment:
'A ClassSelector is an abstract class used to implement the common behaviour for selecting a class from the Smalltalk class hierarchy. It also provides the ability to source and sink drag and drop operations. Dropping a class object onto another class in the tree will change the superclass of the dropped class. A drop of a <CompiledMethod> will copy or move the method to the class under the drop, maintaining its existing method categories. Class objects may also be dragged from a ClassHierarchySelector in a variety of formats: as <Class> objects, as <String> definitions, or as a chunk format definitions.
Note that a ClassSelector maintains whether it is in ''''class'''' (actually metaclass) or ''''instance'''' mode. A number of commands and operations supported by the receiver can be applied to either <Metaclass> or <Class> objects, and which is operated on is determined by the selection and the mode. See #actualClass and its references.
Instance Variables:
flags <integer>. Various flags.
Class Variables:
ClassModeMask <integer>. Masks flags inst. var. to determine if in class mode.'!
!ClassSelector class methodsFor!
initialize
"Private - Initialize the receiver's class variables.
self initialize
"
ClassModeMask := 1! !
!ClassSelector methodsFor!
actualClass
"Answer the actual class selected in the receiver after taking account
of instance or class mode. Answer nil if there is no class selected."
| selectedClass |
selectedClass := self selectionOrNil.
^selectedClass isNil ifFalse: [
self isInstanceMode
ifTrue: [selectedClass]
ifFalse: [selectedClass class]]!
actualClass: class
"Sets the actual class selected and determines the current mode"
^self actualClass: class ifAbsent: [
MessageBox new
owner: self view;
errorMsg: class name, ' is not available for browsing'].!
actualClass: aClass ifAbsent: exceptionHandler
"Sets the actual class selected and determines the current mode."
| class |
aClass isNil ifTrue: [^self resetSelection].
class := aClass instanceClass.
self isInstanceMode: class == aClass.
self selection: class ifAbsent: exceptionHandler!
browseChangedMethods
"Browse the changed methods in the selected classes"
"Private - Answer the name of the <selectableItems> component that actually handles the selectable items in the receiver"
^classesPresenter!
showPresenter: viewName
"Show the selected presenter class in an existing view resource, of the <readableString> name,
viewName, belonging to the selected class."
self selection show: viewName
!
systemModel
"Private - Answer the development system model."
^Smalltalk developmentSystem!
testBrowserClass
^Smalltalk at: #SUnitBrowser ifAbsent: []! !
ListPresenter comment:
'ListPresenter implements a <listPresenter> component that can be used to display the contents of a <listModel> within a <listView>. It also conforms to <selectableItems> and <indexSelectableItems> to provide methods for accessing the current selection(s) in the list.
Instance Variables:
sortBlock <dyadicValuable> or nil, specifying how a objects should be sorted.
'!
!ListPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^ListModel new!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
!ListPresenter methodsFor!
basicBeSorted
"Private - Change the receiver's model sortblock to a default sort block.
The sort is not actually performed"
self sortBlock: self defaultSortBlock!
beNotSorted
"Change the receiver's view model to be an OrderedCollection"
self sortBlock: nil.
self list: self list asOrderedCollection!
beSorted
"Change the receiver's model to be a SortedCollection
using a default sort block"
self basicBeSorted.
self list: self list asOrderedCollection.!
beSorted: aSortBlock
"Change the receiver's model to be a SortedCollection using aSortBlock to determine sort order"
self sortBlock: aSortBlock.
self list: self list!
clear
"Remove all contents in the receiver's model"
self model removeAll!
defaultSortBlock
"Private - Answer a default sort block to use when the receiver is sorted"
^SortedCollection defaultSortBlock!
isSorted
"Answer true if the receiver is sorted by default"
^self sortBlock notNil!
list
"Answer the contents of the receiver"
^self model list!
list: aSequenceableCollection
"Set the contents of the receiver to be aSequenceableCollection"
'A PackageSelector is used to choose a Package from the complete set of packages available in the development system. It presents two panes; a hierarchical display of the folders in which the packages reside and a list of available packages. The folder display can be used as a filter to refine which packages are displayed in the list. When a folder is selected, only packages in the hierarchy beneath it are visible.
Instance Variables:
filterPresenter <treePresenter> showing the folders in which packages reside
packagesPresenter <listPresenter> showing the packages filtered by the selected folder
'!
!PackageSelector class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^PackageHierarchyModel new! !
!PackageSelector methodsFor!
aboutPackage
"Show an About box for the currently selected package"
self selections first about!
addClass
"Request an available Class to add to the receivers current package from the user. Only
classes which are not currently owned by any other package are shown."
'TreePresenter implements a <treePresenter> component that can be used to display the contents of a <treeModel> within a <treeView>. This is similar to the way a tree view is used to display a file system''s contents in the Window''s explorer. For presentation of a tree as a hierarchy of nested "folders" see the <FolderPresenter> class.
TreePresenter conforms to <selectableItems> to provide methods for accessing the current selection. In addition, the <treePresenter> protocol allows the tree to be navigating using the #expand: , #collapse: and #up methods.
'!
!TreePresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^TreeModel new!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
!TreePresenter methodsFor!
collapse: anObject
"Collapse the displayed hierarchy below anObject.
Note that this does not actually remove any nodes from the receiver's model,
i.e. the effect is purely on the view (but see TreeModel>>collapse:)"
self view collapse: anObject!
expand: anObject
"Expand the displayed hierarchy below anObject."
self view expand: anObject!
expandAll: anObject
"Expand the complete hierarchy below anObject (i.e. expand the node and, recursively, all its sub-nodes)."
self view expandAll: anObject!
hasSelection
"Answer true if the receiver has a selection."
^self view hasSelection!
onAboutToEditLabel: anObject
"The receiver's element, anObject, is about to have its label edited in the receiver.
Forward back to the view."
^self view onAboutToEditLabel: anObject!
onLabelOf: anObject editedTo: text
"The receiver's element, anObject, has had its label edited in the receiver to the
specified text. Answer whether to accept the edited text."
^self view onLabelOf: anObject editedTo: text!
selectableItems
"Private - Answer the name of the <selectableItems> component that actually handles the selectable items in the receiver"
^self view!
up
"Display the contents of the immediate parent of the selected tree item"
| parent |
parent := self model parentOf: self selectionOrNil.
self expand: parent! !
ClassHierarchySelector comment:
'A ClassHierarchySelector is used to display a tree of classes. It implements the behaviour common to the class hierarchy panes in the <ClassBrowserShell> and <ClassHierarchyDiagram>.'!
!ClassHierarchySelector class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
"Expands aClass and all it's subclasses in the displayed hierarchy"
classesPresenter expandAll: aClass! !
FolderPresenter comment:
'FolderPresenter is a <treePresenter> component that can be used to display the contents of a <treeModel> within a <listView>. The list is used to display the contents of individual parent nodes within the tree. This is similar to the way a folder view (hence the name) is used to display a directory''s contents in the Windows Shell.. For presentation of a tree but viewing it as a complete hierarchy see the TreePresenter class.
A FolderPresenter can navigate the tree hierarchy using the #expand:, #collapse: and #up <treePresenter> methods.
Instance Variables:
treeItem <Object> the tree node whose child objects are currently displayed.
contentsModel <listModel> holding the current contents.
isAutoNavigate <boolean> true if presenter will implicitly navigate the tree.
openBlock <dyadicValuable> specifying how an object should be opened.
'!
!FolderPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^TreeModel new!
icon
"Answers an Icon that can be used to represent this class"
^##(self) instanceClass defaultIcon! !
!FolderPresenter methodsFor!
beNotSorted
"Change the receiver's view model to be unsorted. We override this
here to ensure that the receiver's display returns to the true order
held by the tree model at this level."
self sortBlock: nil.
self list: (self model childrenOf: treeItem)!
collapse: anObject
"Collapse the displayed hierarchy below anObject.If the receiver is currently displaying
a tree node below anObject's parent then collapse to be displaying the contents of the
parent only. Note that is is not legal to collapse nil."
| parentChain |
parentChain := self model allParentsOf: treeItem.
(parentChain includes: anObject) ifTrue: [
self expand: (self model parentOf: anObject)]!
contents
"Answers a ListModel that contains the receiver's current displayed contents"
^contentsModel!
expand: anObjectOrNil
"Private - Set the receiver to be displaying the contents of anObjectOrNil in the
receiver's tree. If nil then the roots of the tree are displayed"
| contents |
treeItem := anObjectOrNil.
history visit: treeItem.
contents := treeItem isNil
ifTrue: [self model roots]
ifFalse: [self model childrenOf: treeItem].
self contents removeAll; addAll: contents.!
expandAll: anObject
"Expand the complete hierarchy below anObject (i.e. expand the node and, recursively,
all its sub-nodes).
Implementation Note: We only show a single 'level' at a time, so we just implement this
to be the same as #expand:"
self expand: anObject!
historyBack
self expand: (history goBack: 1)!
historyForward
"Navigate forward one position in the history list."
self expand: (history goForward: 1)
!
initialize
"Private - Initialize the receiver"
super initialize.
history := HistoryList new: 10. "A fairly short history list is appropriate"
contentsModel := ListModel new.
self
isAutoNavigate: true;
openBlock: (Message selector: #expand:)
!
isAutoNavigate
"Answer true if the receiver is in automatic navigation mode; i.e. it will
automatically attempt to move around the tree hierarchy using standard
keyboard and mouse gestures"
^isAutoNavigate!
isAutoNavigate: aBoolean
"Set the receiver into automatic navigation mode according to aBoolean"
isAutoNavigate := aBoolean!
list
"Private - Answer the contents of the receiver"
^self viewModel list!
list: aSequenceableCollection
"Private - Set the contents of the receiver to be aSequenceableCollection"
"Private - Answer the model that is to be connected to the view. It is actually
connected to the receiver's contentsModel - not the receiver's tree model"
^self contents! !
MethodBrowser comment:
'MethodBrowser is a <compositePresenter> used to display a <collection> of <CompiledMethod>s. The browser can be instantiated and then filled with methods using #methodsList aspect.
Example:
MethodBrowser show methodsList: Object methodDictionary values.
Note that it is also possible to specify a <monadicValuable> filter that can be used to affect the subsequent maintenance of the browsers content. All methods in the original list are displayed (contrary to the 3.0x class comment). This is useful for when the browser is required to present a number methods meeting a specific criteria. If any of these methods are recompiled (possibly in another browser) the filter is applied once more to see whether the browser should continue to display the method in its list.
Instance Variables:
methodsPresenter <ListPresenter> holding the methods being displayed.
sourcePresenter <SmalltalkWorkspace> for displaying the source of the selected method.
filter <monadicValuable> to determine a factor by which methods are included in the list.
methodAST <StMethodNode>
Class Variables:
AdditionalAccelerators <Array> of <Array> of <Symbol>, <String> pairs.
WordWrap <boolean> indicating whether the source pane should wrap its text.
AutoFormat <boolean> indicating whether source is pretty printed when displayed.
'!
!MethodBrowser class methodsFor!
autoFormat
^AutoFormat!
autoFormat: aBoolean
AutoFormat := aBoolean!
defaultAdditionalAccelerators
^#(#(#widenSourceSelection 'Ctrl+Y'))!
defaultModel
"Answer a default model to be assigned to the receiver when it
'ResourceListPresenter implements a <listPresenter> used to display a list of <ResourceIdentifier>s. It adds the ability to source drag and drop operations for resources, and various commands to operate on resources such as showing them, editing them, browsing their owning class, etc.
Instance Variables:
filterBlock <monadicValuable> used as a discrimator to select resources for inclusion in the list.
'!
!ResourceListPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^ListModel newEquality! !
!ResourceListPresenter methodsFor!
browseHierarchy
"Open a new class browser on the hierarchy at the same point as the receiver."
'TreeListPresenter implements a <listPresenter> component that can be used to display the contents of a <listModel> within a <treeView>. It also conforms to <selectableItems> and <indexSelectableItems> to provide methods for accessing the current selection(s) in the list. The hierarchical presentation is controlled by a tree model (set separately using #treeModel:) but the actual visible nodes are determined by the contents of the list. Only those nodes that are actually in the list or are parents of those in the list will be displayed.
In the default view, the intermediate nodes (i.e. those not in the list) are displayed in a faded colour. By default, these nodes are selectable but this decision can be controlled using #hasProtectedIntermediateNodes:.
Instance Variables:
treePresenter <treePresenter> used to display the objects in the receiver''s list in a hierarchical format.
tlpFlags <Integer> for flag bits.
Class Variables:
ProtectIntermediateNodesMask <Integer> flag mask to indicate whether intermediate tree nodes should be protected.
'!
!TreeListPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^ListModel new!
initialize
"Private - Initialise the receiver's class variables:
self initialize
"
ProtectIntermediateNodesMask := 16r01.
! !
!TreeListPresenter methodsFor!
createSchematicWiring
"Create the trigger wiring for the receiver"
super createSchematicWiring.
self model
when: #listChanged
send: #onListChanged
to: self!
initialize
"Private - Initialize the receiver"
super initialize.
self treeModel: VirtualTreeModel new.
!
list
"Answer the contents of the receiver"
^self model list!
list: aSequenceableCollection
"Set the contents of the receiver to be aSequenceableCollection"
^self model list: aSequenceableCollection!
model
"Private - Answer the list model used to display the contents of the receiver"
^listModel!
model: aListModel
"Set the list model used to display the contents of the receiver"
listModel := aListModel!
onListChanged
"Private - The receiver's list has changed. Repopulate the tree"
| set |
set := Set new.
self list do:
[:each |
set
addAll: (self treeModel allParentsOf: each);
add: each].
self treeModel filter: [:x | set includes: x].
self treeModel: self treeModel
!
onViewOpened
"Received when the receiver's view is been connected. "
super onViewOpened.
self onListChanged.!
refresh
"Private - Refresh the display of the receiver"
| originalSelection |
originalSelection := self selectionOrNil.
self noEventsDo:
[self onListChanged.
self selection: originalSelection ifAbsent: []]!
treeModel
"Private - Answer the tree model used to display the contents of the receiver"
^super model!
treeModel: aTreeModel
"Set the tree model used to display the contents of the receiver to aTreeModel"
super model: aTreeModel.!
viewModel
"Private - Answer the model that is to be connected to the view. It is actually
connected to the receiver's tree model - not the receiver's list model"
^self treeModel! !
Calculator comment:
'Calculator is a <topShell> sample application which illustrates the use of the Dolphin Compiler class in a runtime application. See the package comment for more details.'!
!Calculator class methodsFor!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Smalltalk Calculator'!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Private - Initialize the receiver's class variables
"Private - Create the presenters contained by the receiver"
super createComponents.
input := self add: TextPresenter new name: 'input'.
output := self add: TextPresenter new name: 'output'.
!
displayIt
"Evaluates the contents of the input field as a Smalltalk expression and displays
the result in the output window"
self print: self evaluateIt printString
!
evaluateIt
"Evaluates the contents of the input field as a Smalltalk expression and answers the result"
| result |
[[ result := Compiler evaluate: input value logged: false ]
on: CompilerErrorNotification do: [:x | self print: x description ]]
on: Error do: [:x | self print: 'Error: ', x description ].
input clear.
^result
!
print: aString
"Private - Prints aString to the output tape"
| stream |
stream := String new writeStream.
stream
nextPutAll: output value;
nextPutAll: aString; cr.
output value: stream contents.
output view lineScroll: output view lineCount.
! !
Dialog comment:
'Dialog is an abstract <dialogPresenter> superclass for allowing model data to be displayed and edited within a top-level modal dialog window. The fact that a Dialog is modal means that any changes made to the displayed data are usually buffered and not written directly back to the model until they are explicitly applied. This happens, usually after clicking an OK button. Hence a user has the opportunity of cancelling out of a Dialog without any changes being made to the underlying model.
When designing a <dialogPresenter> it is necessary to make an initial decision as to how the model data should be edited. If the model is a mutable object, in that it is legal (and sensible) to modify it in place using its aspect accessors, then it is sensible to treat it as a simple <dialogPresenter> and it can be subclassed directly from Dialog itself. If, on the other hand, the model is to be immutable then the dialog should be implemented as a <valueDialogPresenter> and, most likely, be subclassed from the ValueDialog class. The decision made here can often be quite subtle. On the one hand, making changes to a mutable object seems the most direct approach, however, a <valueDialogPresenter> can often be more flexible because it can be connected to anything that supports the <valueModel> protocol. Often the choice comes down to this: If the identity of the underlying model data must remain unchanged then use a standard <dialogPresenter>. If this is not the case then a <valueDialogPresenter> will be more suitable.
From this point let us consider the operation of a standard <dialogPresenter>. When the dialog is created, and given a subject model on which to operate, an <AspectBuffer> is created onto this subject. This is used to buffer the changes to any of the subject''s aspects so that they do not affect the original data directly. It is this <AspectBuffer> that is used as the actual model for the <dialogPresenter>. Interestingly, the use of an <AspectBuffer> imposes an additional factor in the decision to use a standard <dialogPresenter> rather than a <valueDialogPresenter>, this being, that the subject model must be capable of being cloned correctly using #copy. For more details see the comment for AspectBuffer itself.
Instance Variables:
confirmed <boolean> indicating whether the dialog has been confirmed and the changes applied.
ownerView <topView> which owns the dialog and is suspended waiting for it to complete.
'!
!Dialog class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
showModal
"Creates a default instance of the receiver with a default view and displays it modal
to the current active window.
Answers the result of the dialog if confirmed or nil otherwise"
^self create showModal!
showModal: aDialogResourceNameString
"Creates an instance of the receiver with a view identified by aResourceNameString
and displays it modal to the current active window.
Answers the result of dialog if confirmed or nil otherwise"
"Creates an instance of the receiver with a view identified by aResourceNameString
and connected to aModel. The view is displayed modal to the current active window.
Answers the result of dialog if confirmed or nil otherwise"
^(self create: aDialogResourceNameString on: aModel) showModal!
showModalOn: aModel
"Creates an instance of the receiver with a default view and connected to aModel.
The view is displayed modal to the current active window.
Answers the result of dialog if confirmed or nil otherwise"
^(self createOn: aModel) showModal! !
!Dialog methodsFor!
answer
"Answer the model if the receiver was confirmed (with #apply, #ok) or nil otherwise"
^self isConfirmed
ifTrue: [ self model subject ]
ifFalse: [ nil ]!
apply
"Apply the changes cached in the receiver back to the original model. This can be used to
dynamically see the effect of the changes without closing the dialog. More often
it is sent by the #ok method just before closing the associated view."
| focus |
"First ensure that any changes cached in the view with focus (if any) are flushed"
focus := View focus.
focus isNil ifFalse: [focus updateModel].
self model apply.
confirmed := true.!
bufferedModelFor: aSubjectModel
"Private - Answers a buffer suitable for the receiver on aSubjectModel. This will become the
actual model to which the receiver is bound. May be overriden by subclasses that
wish to use a different buffering scheme."
^AspectBuffer subject: aSubjectModel.
!
cancel
"Close the receiver without applying the changes back to the original model"
self view close.
!
initialize
"Private - Initialize the receiver"
super initialize.
self ownerView: View active.
confirmed := false
!
isConfirmed
"Answer true if the receiver has been confirmed and changes have been applied
to the associated model. Can be sent after the dialog view has closed
to determine (usually) if the Ok button was pressed."
^confirmed!
model: aSubjectModel
"Set the model of the receiver to be a buffer onto of aSubjectModel."
| actualModel |
actualModel := aSubjectModel notNil ifTrue: [
self bufferedModelFor: aSubjectModel ].
super model: actualModel.!
ok
"Close the receiver and apply the changes cached in the receiver back to the model"
self apply.
self view close.
!
ownerView
"Answer the view that is parent/owner of the receiver"
^ownerView
!
ownerView: aView
"Private - Set the view that is parent/owner of the receiver"
ownerView := aView.
!
revert
"Revert the changes cached in the receiver and go back to the data in the original subject."
self model revert
!
showModal
"Show the receiver's view as a modal dialog.
Answer the model if the receiver was confirmed (with #apply, #okay) or nil otherwise"
self view showModalTo: ownerView.
^self answer !
showShell
"Show the receiver a modeless dialog"
self show!
subject
"Answer the original model onto which the receiver was created"
^self model subject! !
DocumentShell comment:
'DocumentShell is an abstract class describing <documentPresenter>s that wish to be able to load and save their model data from/to a file.
The <documentPresenter> protocol defines a number of methods which may be overriden by the concrete subclasses of DocumentShell. In particular, #isText and #isRichText are available to indicate whether the document data can be saved to one of these two common file formats (ASCII and RTF). If both these methods answer false then the default implementation will choose to save the model data to an STB file stream.
Instance Variables:
filename <readableString> or nil, describing the document filename (if it has been set).
'!
!DocumentShell class methodsFor!
defaultFileExtension
"Answer a default extension that will be used for files saved from
the receiver"
^''!
filename: aStringFilename
"Answers an instance of the receiver open on aStringFilename"
^self show filename: aStringFilename; fileLoad; yourself!
fileTypes
"Answer an Array of file types that can be associated with this
class of document. Overidden by documents that have their own file
types"
^Array with: FileDialog allFilesType
!
open
"Answers an instance of the receiver open on a filename that has been
prompted for. If 'Cancel' is pressed in the file open dialog then
answer nil"
| openFilename |
openFilename := FileOpenDialog new
fileTypes: self fileTypes;
defaultExtension: self defaultFileExtension;
showModal.
openFilename isNil ifTrue: [ ^nil ].
^self filename: openFilename! !
!DocumentShell methodsFor!
basicCaption
"Answer a basic caption that can be used to label the receiver's view.
Normally this is augmented (in #updateCaption) by appending the document file
name"
^''!
createSchematicWiring
"Create the trigger wiring for the receiver"
super createSchematicWiring.
self when: #closeRequested: send: #onCloseRequested: to: self.!
fileLoad
"Loads the receiver from its associated file (if any)"
'PersonalAccountShell is a <topPresenter> for displaying and editing a <PersonalAccount> model. It displays the list of <PersonalAccountTransaction>s currently held by the account together with the initial and current balances. The ability to create, delete and modify existing transactions is provided.
Example of an PersonalAccountShell operating on a new account:
PersonalAccountShell show
Instance Variables:
namePresenter <TextPresenter> holding the account name.
accountNumberPresenter <TextPresenter> holding the account number.
initialBalancePresenter <NumberPresenter> holding the initial balance.
transactionsPresenter <ListPresenter> holding a list of <PersonalAccountTransaction>s.
currentBalancePresenter <NumberPresenter> displaying the current balance.
'!
!PersonalAccountShell class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^PersonalAccount new
! !
!PersonalAccountShell methodsFor!
createComponents
"Create the presenters contained by the receiver"
super createComponents.
namePresenter := self add: TextPresenter new name: 'name'.
accountNumberPresenter := self add: TextPresenter new name: 'accountNumber'.
initialBalancePresenter := self add: NumberPresenter new name: 'initialBalance'.
transactionsPresenter := self add: ListPresenter new name: 'transactions'.
currentBalancePresenter := self add: NumberPresenter new name: 'currentBalance'.
!
createSchematicWiring
"Create the trigger wiring for the receiver"
super createSchematicWiring.
transactionsPresenter when: #actionPerformed send: #editTransaction to: self.
'RegEdit is a <topShell> sample application which implements most of the functionality of the Windows utility, RegEdit. It does not implement the full functionality of the standard tool because it is primarily intended as a demonstration of the use of registry access classes, and the tree and enhanced list views. It supports in-place registry key name editing.
Example:
RegEdit show
BE WARNED, as with the standard RegEdit, it is possible to corrupt your registry with this tool, so please use with care!!
Instance Variables:
keyPresenter <TreePresenter> holding the hierarchy of registry keys.
valuesPresenter <ListPresenter> displaying the registry entries for selected keys.
statusModel <ValueHolder> for displaying status information.
Class Variables:
ResourceLib <ExternalResourceLibrary> for accessing resources within the standard REGEDIT.EXE.
'!
!RegEdit class methodsFor!
about
"Private - Pop up a little helpful info. about this sample program."
"Private - Initiate in-place label edit of the selected key."
keyPresenter view editSelectionLabel!
renameSelectedValue
"Private - Initiate in-place label edit of the selected key."
valuesPresenter view editSelectionLabel!
resourceLib
"Answer the registry editor resource library (regedit.exe)."
^ResourceLib!
selectedKey
"Answer the currently selected registry key."
^keyPresenter selectionOrNil!
selectedValue
"Answer the currently selected registry entry."
^valuesPresenter selectionOrNil! !
SmalltalkToolShell comment:
'SmalltalkToolShell is an abstract <topPresenter> providing umbrella functionality for most of the Dolphin development tools.
All of the tools have the singleton instance of SmalltalkSystem as their model. This makes sense because the SmalltalkSystem is effectively a Facade onto the Smalltalk development image; all user interface modifications to the image should go through this central point. In this way, a tool is effectively acting as a view onto the development image. It is also convenient since all <model>s are also <commandTarget>s. This means that some user interface commands can be directly picked up and acted upon by the SmalltalkSystem without any intervention being required from the tool itself.
Class Variables:
ReuseIfOpenMask <integer> mask used to get/set the ''re-use if open'' flag.
Class Instance Variables:
optionFlags <integer>
defaultView <String> name of the default view.
defaultExtent <Point> specifying the default size of new views, nil if none set.
additionalAccelerators <Array> of 2-element <Array>s, being command <Symbol> accelerator key <String> pairs
'!
!SmalltalkToolShell class methodsFor!
defaultAdditionalAccelerators
"Answer a collection of additional accelerator definitions for commands not on the menu bar of the receiver's view(s).
Each element of the collection should be a two element <Array>, the first element of which is the command symbol
and the second the accelerator key string."
^#(#(#inspectIt 'Shift+Ctrl+I'))!
defaultExtent
"Answer a <Point> which is the user's chosen default extent for new instances
of the receiver, or nil if left up to Windows."
^defaultExtent!
defaultExtent: aPoint
"Set the default extent to be used for instances of the receiver to the <Point> argument.
If the argument is nil, then let Windows decide."
defaultExtent := aPoint!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^SmalltalkSystem current!
defaultView
"Answer the resource name of the default view for the receiver.
This is configurable for tool shells so that the developer can easily replace the
standard Dolphin views if he or she wishes. For example one can reconfigure
to use simple class browser view if using a portable machine with limited screen
real estate."
defaultView isNil ifTrue: [defaultView := super defaultView].
^defaultView!
defaultView: aString
"Set the default view name."
defaultView := aString!
getAdditionalAccelerators
^additionalAccelerators!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Private - Initialize the receiver's class variables."
ReuseIfOpenMask := 1. "Flags up to 16r80000 are reserved for common flags"!
initializeAfterLoad
"Perform any post-load initialisation for the class.
Superclass method only initializes direct implementors, so we must initialize others."
self initializeOptionFlags.
super initializeAfterLoad.!
initializeOptionFlags
"Private - Set the default option flags."
optionFlags := 0!
notificationGetImageBlock
"Private - Answer a monadic valuable used for getting the image for a compiler
notification status pane."
^IconicListAbstract!
notificationGetTextBlock
"Private - Answer a monadic valuable used for getting the text for an compiler
notification status pane."
^BasicListAbstract!
publishedAspects
"Answer a <LookupTable> of the <Aspect>s published by the receiver."
'TranscriptShell is a <SmalltalkToolShell> that implements the Transcript notification logging window.
Note that although TranscriptShell is a development tool, it is not dependent on the Development System package to operate. Among the Dolphin development tools it is unusual in that its model is not SmalltalkSystem, which means that it has to reproduce some of the functionality normally implemented there.
Instance Variables:
workspacePresenter <SmalltalkWorkspace> displaying the contents of the Transcript.
buffer <WriteStream> for accepting logging information.
bufferProtect <Mutex> protecting the buffer.
'!
!TranscriptShell class methodsFor!
create
"Answers an instance of the receiver with a default view.
The receiver is a singleton whose single instance is referenced
via a global variable (for historical and convenience reasons)
and so we intervene to subdue calls for a new king."
Although an original Smalltalk-80 selector, this is now deprecated because it is redundant.
The standard stream protocols should be used when writing to the Transcript."
#deprecated.
self nextPutAll: aString; flush!
smalltalkFilesType
"Private - Answer a two element array suitable for adding to the FileDialog
with the fileTypes: message."
^#('Smalltalk Files (*.st)' '*.st')!
space
"Append a space to the receiver."
self nextPutAll: ' '!
tab
"Store a tab character as the next element of the receiver."
self nextPutAll: String tab!
tab: tabCount
"Append the specified number of tabs to the receiver."
tabCount timesRepeat: [self tab]! !
VideoLibraryShell comment:
'VideoLibraryShell a modeless user interface for displaying and editing the contents of a VideoLibrary. This class is part of the Video Library sample package. Please see the package comment for more details.
Example:usage
VideoLibraryShell show.
or
VideoLibraryShell showOn: (VideoLibrary new owner: ''Mary Joe'')'!
!VideoLibraryShell class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^VideoLibrary default!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Video Library'!
icon
"Answers an Icon that can be used to represent this class"
^VideoLibrary icon!
initialize
"Private - Initialize the receiver's class variables
'WebBrowserShell is a simple web browser application built around the Microsoft Web Browser control (the basis of Internet Explorer).
This sample does wire up to a few events from the brower control (mainly for illustrative purposes), but if you want to learn more about what events are fired and when it is recommended that you monitor the behaviour of the control using the ''Active-X Control Browser'' tool.
Try:
WebBrowserShell show
Instance Variables:
address <TextPresenter>. The text URL being browsed/to be browsed.
browser <URLPresenter>. Presenter behind the explorer view.
statusModel <ValueHolder>. Model to hold status text updated by events from the explorer control.
'!
!WebBrowserShell class methodsFor!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Simple Web Browser'!
icon
"Answers an Icon that can be used to represent this class"
^Icon fromId: 14 in: ShellLibrary default!
initialize
"Private - Initialize the receiver's class variables
'A DolphinSureTrustWarning dialog is used to presenter a publisher''s digital certificate and to prompt the user to see if contents from this publisher should be trusted. The model for this dialog is the certificate itself and, if it is accepted, it is entered into a temporary or permanent trust store as appropriate.
DolphinSureTrustWarning showModal
Instance Variables:
certificateImage <ImagePresenter> used to display the certificate.
description <TextPresenter> used to display a description of the signed class.
alwaysTrust <BooleanPresenter> used to indicate whether the user always wants to trust this certificate.
'!
!DolphinSureTrustWarning class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized. This should be an instance of DolphinSureCertificate"
'ProgressDialog is a <valueDialogPresenter> that can be used to indicate the progress of a background operation. The <valueModel> is used to hold a <number> that describes the current amount of progress through the operation. Typically, with the standard views, this will be an <integer> between 0 and 100%.
The various [instance creation] methods accept a <monadicValuable> operation which is evaluated in a background process. The parameter passed to the operation is the <valueModel> of the ProgressDialog. It is then the responsibility of the operation, as it progresses, to periodically update this with the state of progress.
The class includes a number of examples to demonstrate its use:
ProgressDialog example1.
ProgressDialog example2.
ProgressDialog example3.
Instance Variables:
progressPresenter <NumberPresenter> displaying the current state of progress.
operation <monadicValuable> holding the operation to be performed.
process <Process> evaluating the operation.
textPresenter <TextPresenter> displaying the descriptive text to describe the operation.
'!
!ProgressDialog class methodsFor!
create: viewName operation: operation
"Answer a new instance of the receiver with a view identified by viewName
to evaluate the monadic valuable argument, operation, when the
instance is subsequently shown (e.g. by sending it #showModal).
When the view is shown the operation is evaluated in a background
process, and is passed the progress dialog to be updated with its
progress (#value: 0..100, #text: aString). If the instances cancel button
is pressed, then the operation is terminated and the answer is nil. If the operation
runs to completion, then the answer is result of the evaluation."
^(self create: viewName)
operation: operation!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^nil asValue!
example1
"A simple modal progress dialog. Notice how the progress text can also be set within
the operation block. Try pressing cancel to see the effect on the answer.
ProgressDialog example1
"
^self showModalWhile: [:progress |
1 to: 100 do: [:i | Processor sleep: 30. progress value: i; text: i displayString, '%']. 'completed']!
example2
"A simple modeless progress dialog.
x := ProgressDialog example2
Try evaluating these expressions while the progress dialog is up:
x progress.
x isConfirmed.
x answer.
"
^(self operation:
[:progress |
1 to: 100
do:
[:i |
Processor sleep: 100.
progress
value: i;
text: i displayString , '%'].
'completed'])
caption: 'Modeless progress...';
show!
example3
"A simple modal progress dialog with an alternative view.
ProgressDialog example3
"
^(self
create: 'Numeric progress dialog'
operation: [:progress |
10 to: 1 by: -1 do: [:i | progress value: i. Processor sleep: 400]. 'completed'])
caption: 'Count down ...';
allowCancel: false;
showModal!
icon
"Answers an Icon that can be used to represent this class."
^Time icon
!
operation: operation
"Answer a new instance of the receiver with the default view
to evaluate the monadic valuable argument, operation, when the
instance is subsequently shown (e.g. by sending it #showModal).
When the view is shown the operation is evaluated in a background
process, and is passed a progress dialog to be updated with its
progress (#value: 0..100, #text: aString). If the instances cancel button
is pressed, then the operation is terminated and the answer is nil. If the operation
runs to completion, then the answer is result of the evaluation."
"Received when the receiver's view has been connected. "
super onViewOpened.
classTreePresenter selection: classValue value.
! !
ValueDialog comment:
'ValueDialog is an abstract <valueDialogPresenter> superclass for allowing <valueModel> data to be displayed and edited within a top-level modal dialog window. When deciding whether to implement a dialog as a plain <dialogPresenter> or as a <valueDialogPresenter> there are a number of considerations to take into account. These are discussed in the comment for the Dialog class.
For the most part a <valueDialogPresenter> operates in much the same way as any <dialogPresenter>. However, its subject will always be a <valueModel>, although the value that this refers to will obviously be different for each dialog. When the dialog is created, the actual model that is installed is a <ValueBuffer> onto the subject. This is a type of <valueHolder> that is used to buffer any changes to the subject''s value so that they will not be written back to the original model until an explicit #apply request is made.
'!
!ValueDialog class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^nil asValue
!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #valueChanged;
yourself.
! !
!ValueDialog methodsFor!
answer
"Answer the model if the receiver was confirmed (with #apply, #okay)
or nil otherwise. Dereference the value from the model since this will
be most useful"
^self isConfirmed
ifTrue: [ self model value ]
ifFalse: [ nil ]!
bufferedModelFor: aSubjectValueModel
"Private - Answers a buffer suitable for the receiver on aSubjectValueModel. This will become the
"Set the model of the receiver to be aValueModel. Register with it's #valueChanged
event"
super model: aValueModel.
aValueModel when: #valueChanged send: #onValueChanged to: self!
onValueChanged
"The value held by the receiver's model has changed.
The default is to trigger a #valueChanged event off the receiver"
self trigger: #valueChanged!
value
"Answer the model value of the receiver"
^self model value!
value: anObject
"Set the model value of the receiver to be anObject. The change
will not be flushed back to the original subject model until #apply
is received"
self model value: anObject.! !
VideoRecordingDialog comment:
'VideoRecordingDialog provides a modal user interface for editing the contents of a VideoRecording object in place. This class is part of the Video Library sample package. Please see the package comment for more details.
Example:
self showModalOn: VideoRecording new "Display it"'!
!VideoRecordingDialog class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^VideoRecording new
!
icon
"Answers an Icon that can be used to represent this class"
^VideoRecording icon! !
!VideoRecordingDialog methodsFor!
createComponents
"Create the presenters contained by the receiver"
super createComponents.
titlePresenter := self add: TextPresenter new name: 'title'.
datePresenter := self add: DatePresenter new name: 'date'.
timePresenter := self add: TimePresenter new name: 'time'.
lengthPresenter := self add: NumberPresenter new name: 'length'.
!
model: aVideoRecording
"Set the model associated with the receiver to aVideoRecording."
super model: aVideoRecording.
"From this point on 'self model' is the buffered version of aVideoRecording"
titlePresenter model: (self model aspectValue: #title).
datePresenter model: (self model aspectValue: #date).
timePresenter model: (self model aspectValue: #time).
lengthPresenter model: (self model aspectValue: #length).
! !
AXTypeLibraryPrompter comment:
'AXTypeLibraryPrompter is a <valueDialogPresenter> that can be used to prompt for a COM component type library to install into the image. Its displays a list of all the registered type libraries (including those already installed) and also gives the user an opportunity to load a type library directly from a DLL, OCX, EXE, or TLB file. The subject <valueModel> is filled with an instance of AXTypeLibrary representing the chosen library when the dialogue is confirmed.
Note that the prompter takes care not to actually load the type libraries until the user chooses one.
Example:
AXTypeLibraryPrompter showModal "Display it"
Instance Variables:
typeLibs <ListPresenter> displaying a list of <AXTypeLibRegistration>s.
path <TextPresenter> displaying the path to the chosen type library.
'ChoicePrompter is a <valueDialogPresenter> that allows a value to be chosen from a list of alternatives.
You can instantiate a single selection ChoicePrompter dialog using the class methods #choices:caption: or #on:choices:caption:. It is also possible to allow multiples selections by using the methods #multipleChoices:caption: and #on:multipleChoices:caption:. Each of these methods answers the model value if Ok (or nil if Cancel) is pressed. When a ChoicePrompter is being used to select multiple choices, the < valueModel> will be used to contain an Array of the selected items.
Since a ChoicePrompter is really just a dialog wrapper around a <ChoicePresenter> it presents most of the functionality of the latter in an easy to use dialog form. The initial selection of choices in the dialog will match the initial value of the model. The selections made in the choices list will not be transferred to the <valueModel> unless Ok is used confirm the dialog. If Cancel is pressed the model will be left untouched.
It is also possible to configure a ChoicePrompter such that new entries may be added dynmaically to the list of choices. This can be done by specifying a <monadicValuable> using #newBlock:. When a #newChoice or #newMultipleChoice command is received from the view, a standard <Prompter> will be displayed and the resultant text from this will be run through the newBlock to determine the choice or choices to be added to the list. In order to enable this functionality it is necessary to explicitly specify the view as "Extensible choice prompter" or "Extensible multi-selection choice prompter", as appropriate.
(item items isEmpty and: [item text beginsWith: self untitledPrefix])
ifTrue: [aMenu removeItem: item]]!
topMenuInset
"Private - Anser the offset of the top menu from the origin of
the receivers client view."
^10@10!
untitledPrefix
"Private - Answer the prefix to be used for as yet untitled menus and items."
^'untitled '!
update: aMenuComposerView do: operation
self closeSubmenuViewsOf: aMenuComposerView.
operation value.
aMenuComposerView updateMenu.
self openSelectedSubmenuOf: aMenuComposerView! !
NewVideoTapeDialog comment:
'NewVideoTapeDialog provides a modal user interface gathering the necessary information that is required before a new VideoTape can be instantiated. The dialog is somewhat different than many other dialogs because it does not attempt to edit a specialised model (in this case a VideoTape). Since the VideoTape class has a Instance Creation Method, #name:length:, that require name and length parameters, the NewVideoTapeDialog is used only to collect this information prior to the creation of a tape instance.
This class is part of the Video Library sample package. Please see the package comment for more details.
Example usage:
NewVideoTapeDialog showModal. "Display it"
'!
!NewVideoTapeDialog class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^VideoTape icon! !
!NewVideoTapeDialog methodsFor!
apply
"Apply the changes cached in the receiver back to the model. "
self value: (VideoTape name: self name length: self length).
super apply
!
createComponents
"Create the presenters contained by the receiver"
super createComponents.
namePresenter := self add: TextPresenter new name: 'name'.
lengthPresenter := (self add: ChoicePresenter new name: 'length').
!
length
"Answer the <Integer> contents of the length field"
^lengthPresenter value!
name
"Answer the <readableString> contents of the name field"
^namePresenter value!
onViewOpened
"Received when the receiver's view has been connected. "
super onViewOpened.
namePresenter value: '<New Tape>'.
lengthPresenter
choices: #(30 60 120 180 240);
value: 240.
! !
PackagePrompter comment:
'self show'!
!PackagePrompter class methodsFor!
icon
"Answers an Icon that can be used to represent this class."
"Received when the receiver's view has been connected."
super onViewOpened.
packagesPresenter selectionOrNil: self model value!
queryCommand: query
"Private - Enters details about a potential command for the receiver into
the <CommandQuery>, query"
| cmd |
cmd := query commandSymbol.
cmd == #ok
ifTrue:
[query isEnabled: self value notNil.
^true].
^super queryCommand: query!
toggleSetPackage
notPackagedPresenter model value
ifFalse:
[self value: packagesPresenter selectionOrNil.
packagesPresenter isEnabled: true]
ifTrue:
[self value: defaultPackage.
packagesPresenter isEnabled: false]! !
Prompter comment:
'Prompter is a <valueDialogPresenter> that can be used to prompt a user to enter a <readableString> response to a question. The <valueModel> initially holds the default response and, if the dialog is confirmed, will hold the actual response from the user.
Instance Variables:
promptPresenter <TextPresenter> holding the prompt text.
replyPresenter <TextPresenter> holding the reply text.
"Set the <monadicValuable> used to validate the user's reply. The
valuable is passed the current reply text as its argument, and is expected
to answer whether it is valid. The OK button is not enabled until the
validationBlock answers true."
validationBlock := aBlock! !
BrowseFolderDialog comment:
'BrowserFolderDialog is a <valueDialogPresenter> implementing the Windows SHBrowseForFolder common dialog. The associated <valueModel> contains a <readableString> indicating the path of the chosen folder.
Instance Variables:
style <integer> Windows style flags for the common dialog.
callback <ExternalCallback>. Callback function to receive messages from common control.
bfFlags <integer>. Various flags.
Class Variables:
Handlers <Array>. Selectors of callback handlers.
InitializedMask <integer>. Bit mask for isInitialized flag.
"Answers the style flags to be used when the receiver is opened."
^style!
style: anInteger
"Set the style flags to be used when the receiver is opened."
style := anInteger!
winStructClass
"Private - Answer the class to use for the receiver's associated windows parameter structure."
^OPENFILENAME! !
FindDialog comment:
'FindDialog is a <valueDialogPresenter> implementing the Windows FindText common dialog. The dialog must be associated with an owner view capable of responding to the <textFinder> protocol. It will then remain on-screen until dismissed and will forward <FindEvent>s to the owner via its #onFind: event handler.
Instance Variables:
findWhat <readableString> or nil, specifying the text to search for.
'!
!FindDialog class methodsFor!
ownerView: aView
"Create and show a new instance of the receiver with
with a aView as the owner."
^self new
initialize;
ownerView: aView;
showModal;
yourself!
ownerView: aView findWhat: findString
"Create and show a new instance of the receiver with
with a aView as the owner. Pre-populate the dialog with the
argument findString."
^self new
initialize;
ownerView: aView;
findWhat: findString;
showModal;
yourself! !
!FindDialog methodsFor!
basicShowModal
"Private - Create and show a new FindText dialog."
"Private - Initialize the parameter structure to be passed to the Win32
API associated with this common dialog, immediately prior to the call
to that API."
| font |
font := self value isNil
ifTrue: [ Font default ]
ifFalse: [ self value ].
logFont := font logFont copy.
self winStruct lpLogFont: logFont.!
winStructClass
"Private - Answer the class to use for the receiver's associated windows parameter structure."
^CHOOSEFONT! !
PrintDialog comment:
'PrintDialog is a <valueDialogPresenter> implementing the Windows PrintDlg common dialog. The associated <valueModel> contains an <integer> representing the device context handle (HDC) for the chosen printer.'!
!PrintDialog methodsFor!
basicShowModal
"Private - Create and show a new Print dialog. Hang it off the receiver's parent view.
Answer an new hDC on the selected printer. The hDC should be freed using
"Sets aInterval to dicate the page range available"
self winStruct
nMinPage: anInterval first;
nMaxPage: anInterval last.
!
prepareStruct
"Private - Initialize the parameter structure to be passed to the Win32
API associated with this common dialog, immediately prior to the call
to that API."
"Nothing to do"!
printRange
"Answers an Interval that dicates the page range to be printed"
^self winStruct nFromPage to: self winStruct nToPage.!
printRange: anInterval
"Sets aInterval to dicate the page range to be printed"
self winStruct
nFromPage: anInterval first;
nToPage: anInterval last.
!
winStructClass
"Private - Answer the class to use for the receiver's associated windows parameter structure."
^PRINTDLG! !
FileOpenDialog comment:
'FileOpenDialog is a <valueDialogPresenter> implementing the Windows GetOpenFileName common dialog. The associated <valueModel> contains a <readableString> indicating the path of the chosen file.
'!
!FileOpenDialog methodsFor!
commonDialogSelector
"Private - Answer the selector to use to get the result."
^#getOpenFileName:
!
defaultStyle
"Answers the style for the receiver."
^super defaultStyle bitOr: OFN_FILEMUSTEXIST! !
FileSaveDialog comment:
'FileSaveDialog is a <valueDialogPresenter> implementing the Windows GetSaveFileName common dialog. The associated <valueModel> contains a <readableString> indicating the path of the chosen file.'!
!FileSaveDialog methodsFor!
commonDialogSelector
"Private - Answer the selector to use to get the result."
^#getSaveFileName:
! !
FindReplaceDialog comment:
'FindReplaceDialog is a <valueDialogPresenter> implementing the Windows ReplaceText common dialog. The dialog must be associated with an owner view capable of responding to the <textFinder> protocol. It will then remain on-screen until dismissed and will forward <FindEvent>s to the owner via its #onFind: event handler.
Instance Variables:
replaceWith <readableString> specifying the replacement text.
"Private - Initialize the parameter structure to be passed to the Win32
API associated with this common dialog, immediately prior to the call
to that API."
self winStruct
flags: FR_DOWN;
lpstrFindWhat: self findWhat;
wFindWhatLen: self findWhat size;
lpstrReplaceWith: self replaceWith;
wReplaceWithLen: self replaceWith size.!
replaceWith
"Private - Answer the receievrs replceWith String."
^replaceWith!
replaceWith: aString
"Private - Set the receivers replaceWith String to include aString."
| size |
size := self replaceWith size min: aString size.
self replaceWith replaceFrom: 1 to: size with: aString.! !
MenuBarComposer comment:
'MenuComposer is a <valueDialogPresenter> that can be used to edit a <MenuBar> held in its <valueModel>.'!
!MenuBarComposer class methodsFor!
menuClass
"Private - Answer the base menu class that instances of the receiver will edit|"
^MenuBar! !
PersonalMoneyShell comment:
'PersonalMoneyShell is a <documentPresenter> providing the main user interface for the Personal Money sample system. The interface is displayed in a top level shell window. The model data on which the PersonalMoneyShell operates is an instance of <PersonalMoney>. Since the class conforms to <documentPresenter> it automatically has the ability to save and load the PersonalMoney data to/from disk.
To create a new Personal Money system evaluate:
PersonalMoneyShell show.
Instance Variables:
ownerPresenter <TextPresenter> holding the owners name.
accountsPresenter <ListPresenter> holding a list of <PersonalAccount>s.
'!
!PersonalMoneyShell class methodsFor!
defaultFileExtension
"Answer a default extension that will be used for files saved from
the receiver"
^'pm'!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^PersonalMoney new
!
fileTypes
"Answer an Array of file types that can be associated with this
class of document."
^#( ('Personal Money files (*.pm)' '*.pm')
('All Files (*.*)' '*.*') )! !
!PersonalMoneyShell methodsFor!
createComponents
"Create the presenters contained by the receiver"
super createComponents.
ownerPresenter := self add: TextPresenter new name: 'owner'.
accountsPresenter := self add: ListPresenter new name: 'accounts'.
!
createSchematicWiring
"Create the trigger wiring for the receiver"
super createSchematicWiring.
accountsPresenter when: #actionPerformed send: #editAccount to: self.
!
editAccount
"Edit the selected account"
| account index shell |
self hasSelectedAccount ifTrue: [
account := self selectedAccountOrNil.
shell := PersonalAccountShell showOn: account.
shell when: #viewClosed send: #updateAccount: to: self with: account ].
!
hasSelectedAccount
"Answer true it there is a currently selected account in the receiver"
self model accounts updateItem: aPersonalAccount! !
SmalltalkWorkspaceDocument comment:
'SmalltalkWorkspaceDocument is a <documentPresenter> that can be used for displaying Smalltalk ST and CLS files. It also allows for the evaluation of Smalltalk expressions and the execution of various other commands targeted at the <SmalltalkSystem> singleton instance.
Instance Variables:
workspacePresenter <SmalltalkWorkspace> holding the workspace text.
Class Variables:
ReuseIfOpen <boolean> indicating whether an open workspace should be re-used in preference to opening a new one.
'!
!SmalltalkWorkspaceDocument class methodsFor!
defaultAdditionalAccelerators
"Private - Answer a collection of additional accelerator definitions for commands not on the menu bar of the receiver's view(s).
Each element of the collection should be a two element <Array>, the first element of which is the command symbol
and the second the accelerator key string."
^#(#(#inspectIt 'Shift+Ctrl+I'))!
defaultBackcolor
"Answer the default background to use for instances of the receiver"
^SmalltalkWorkspace defaultBackcolor!
defaultBackcolor: aColorOrNil
"Set the default background to use for instances of the receiver"
"Record the size of the receiver as the default extent for its tool class."
self class defaultExtent: self view extent!
setDocumentData: text
"Private - Set the data for the receiver's document to text (a String or RichText)."
self workspace text: text!
show
"Shows the view of the receiver.
Pick up the default extent if any."
| ext |
ext := self class defaultExtent.
ext isNil ifFalse: [self view extent: ext].
^super show!
smalltalkExit
"Request system shutdown - may be cancelled by user."
self model smalltalkExit!
systemModel
^SmalltalkSystem current!
workspace
"Answers the SmalltalkWorkspace held by the receiver."
^workspacePresenter! !
TextDocument comment:
'TextDocument is a <documentPresenter> capable of displaying and editing a <readableString> document.
Instance Variables:
documentPresenter <TextPresenter> holding the document text.
'!
!TextDocument class methodsFor!
defaultFileExtension
"Answer a default extension that will be used for files saved from
the receiver"
^'txt'!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^String new asValue!
fileTypes
"Answer an Array of file types that can be associated with this
class of document."
^Array
with: #('Text Files (*.txt)' '*.txt')
with: FileDialog allFilesType! !
!TextDocument methodsFor!
createComponents
"Create the presenters contained by the receiver"
super createComponents.
documentPresenter := self add: TextPresenter new name: 'document'!
fileNew
"The user has selected the standard File/New command."
self promptToSaveChanges ifTrue: [
self filename: nil.
self setDocumentData: String new]!
getDocumentData
"Private - Answer the data for the receiver's document."
^self model value!
isModified
"Answer whether the document in the receiver has been modified."
^documentPresenter isModified!
isModified: aBoolean
"Set/reset the receiver's dirty flag."
documentPresenter isModified: aBoolean!
isText
"Answer true if the receiver is a text document"
^true!
model: aStringValueModel
"Set the model associated with the receiver."
super model: aStringValueModel asValue.
documentPresenter model: self model
! !
Notepad comment:
'Notepad is a <topShell> sample application which implements most of the functionality of the familiar Windows utility. The major area of missing functionality is printing. Most of the implementation of the application is actually inherited from Dolphin''s TextDocument framework class.
Note that some resources are extracted from the Windows executable, but none of the functionality of that executable is reused (or indeed could be, as Notepad.exe doesn''t export any functions).
Example:
Notepad show
Class Variables:
ResourceLib <ExternalResourceLibrary> for accessing resources within the standard NOTEPAD.EXE.
'!
!Notepad class methodsFor!
about
"Private - Pop up a little helpful info. about this sample program."
'AXComponentWizard is a <SmalltalkToolShell> that manages the creation of interface classes for ActiveX components. To bring up an AXComponentWizard, open the appropriate icon in System Folder/Additional Tools/ActiveX Wizards or evaluate:
AXComponentWizard show
When initially displayed, the AXComponentWizard presents a list of all of the current instances of <AXTypeLibraryAnalyzer> in the image. Dolphin uses <AXTypeLibraryAnalyzer>s to scan the contents of type libraries and to generate Smalltalk classes for the interfaces they contain. Using the wizard, you can choose to generate (or re-generate) these interface classes at any time.
If the particular type library required is not yet installed in this image, it can be added by clicking on the ''Browse...'' button. This will bring up a prompter allowing you to choose a type library registered on the current machine to be added to the image. An instance of AXTypeLibraryAnalyzer is created and will be assigned to a unique global should you later generate any interfaces or structures from the library.
Before generating the interface classes, the wizard allows you to choose a prefix that will be applied to the generated class names (the default is the name of the type library) and which package to place the classes into by default. If these interface classes already exist then you may later be prompted as to whether to leave them in their current package or move them. The globals holding the instances of <AXTypeLibraryAnalyzer> are also assigned to packages allowing them to be exported from the image along with the interface classes that they manage.
The next step is to choose the interfaces and/or structures for which you wish to generate wrapper classes. The wizard displays a list of the available interfaces and structures. Types which already have wrapper classes in the image are ticked with a check mark, but not that these may not be fully generated wrapper classes (the wizard sometimes generates empty stub classes where another wrapper class needs to refer to the type). You may choose a multiple selection of interfaces to be (re-)generated.
Click ''Generate'' to install the classes for the chosen interfaces. The operation may take some time depending on the complexity of the type library and the interfaces selected.
Instance Variables:
typeLibs <ListPresenter> holding the list of currently loaded type libraries.
interfaces <ListPresenter> displaying a list of types (not just interfaces) for the currently selected type library.
description <TextPresenter> displaying the description of the currently selected type library.
guid <TextPresenter> displaying the GUID of the currently selected type library.
globalName <TextPresenter> displaying the name of the currently selected typed library.
prefix <TextPresenter> holding a prefix for all generated class names.
packageName <TextPresenter> holding a default package name into which all classes will be generated.
forcePackage <BooleanPresenter> reserved for future use.
cards <WizardCardContainer>. The container of the wizard''s card stack.
libraryName <TextPresenter> displaying the name of the currently selected typlib.
libraryVersion <TextPresenter> displaying the version of the currently selected typelib.
libraryPath <TextPresenter> displaying the location of the currently selected typelib.
prefixClasses <BooleanPresenter>. Whether prefix will be preprended to generated class names.
buffer <AspectBuffer>
typelibGlobal <BooleanPresenter>. Whether a global variable will be generated to represent the typelib.
constantsPoolName <TextPresenter>. Name of the <PoolConstantsDictionary> generated to hold consts from the typelib.
highLevelWrappers <ChoicePresenter>. Verbosity of high-level method wrapper generation.
classComments <ChoicePresenter>. Level of class comment to generate.
tracing <ChoicePresenter>. Tracing level.
defineProtocols <BooleanPresenter>. Whether to generate Dolphin method protocols for COM interfaces.
defineFunctionTables <BooleanPresenter>. Whether to generate #defineFunctions methods to enable Dolphin COM servers
'ClassBrowserAbstract is an abstract <SmalltalkToolShell> that implements most of the functionality required for a class browser development tool. Concrete subclasses implement the Class Hierarchy Browser and System Browser development tools.
Instance Variables:
classesPresenter <ClassHierarchySelector> displaying the class hierarchy.
categoriesPresenter <treePresenter> displaying the category hierarchy filtered for methods of the selected class.
methodBrowserPresenter <MethodBrowser> browsing methods in the selected class.
definitionPresenter <SmalltalkWorkspace> holding the current class definition.
commentPresenter <SmalltalkWorkspace> holding the current class comment.
modePresenter <listPresenter> displaying the Instance and Class mode tabs.
flags <integer> mode flags for the browser.
history <HistoryList> keeping a history of visited methods.
variablesPresenter <listPresenter> holding a list of instance variables for the current class.
protocolsPresenter <listPresenter> holding a list of protocols that the current class conforms to.
filterPresenter <CardContainer> holding the Categories, Protocols and Variables cards.
packageModel <valueModel>
statusModel <valueModel>
Class Variables:
DefaultPackageName <readableString> package name into which new classes are added by default.
LooseMethodColor <Color> used to paint foreground text of loose methods'' selectors in method pane
WordWrapComment <boolean> indicating whether the comment pane should would wrap.
WordWrapDefinition <boolean> indicating whether the definition pane should word wrap.
ShowInheritedMethodsMask <integer>
FilterObjectMethodsMask <integer>
Class Instance Variables:
DefaultShowInheritedMethods <boolean>
DefaultFilterObjectMethods <boolean>
'!
!ClassBrowserAbstract class methodsFor!
availablePluginClasses
"Private - Answers a collection of plugin classes to choose from"
'Debugger is a <SmalltalkToolShell> that implements the standard debugging tool. The debugger is usually invoked from a walkback dialog by pressing the Debug button. Walkbacks are displayed in the development environment when a breakpoint (''self halt'') is encountered, or when an unhandled exception occurs. It is also possible to configure the system so that debuggers are opened automatically when breakpoints are encountered or errors occur (see the Debugger options in Dolphin Options), though this is not particularly recommended as it can make the system crash if the error or breakpoint is in some code that is itself used by the Debugger.
Dolphin''s Debugger does not simulate execution as in some Smalltalk''s, but instead uses the VM''s built-in debugging event generation to run the code and interrupt it at appropriate points. This results in more consistent and faster execution, although note that the debugger will recompile methods being stepped through to insert breakpoints and this may cause some peephole compiler optimizations to be lost.
The protocol <debugEventHandler> shows the messages sent (indirectly via Processor) by the VM when debug events occur such as breakpoints and single-steps. These debug events could quite easily be used for other purposes such as profiling tools. However note that this protocol is private, and may change in future versions. It is worth noting that single-step events are generated by hooking into the message dispatch mechanism in such a way that has no measurable effect on the speed of normal operation, and breakpoints are generated by inserting a breakpoint instruction rather than by performing conditional tests (i.e. the VM does not contain any code to support debugging which would slow down normal operation, and hence there is no separate debug/release build).
Dolphin serializes callback returns to maintain LIFO order on the machine stack even in the presence of multiple threads of execution (Smalltalk Processes) and thus it is quite feasible to debug into callbacks which route through external code such as parts of the OS, for example one can step into a SendMessage call and break in the Dolphin window procedure. One can also debug through COM method invocations, even back into Dolphin, and set breakpoints in COM method implementations that will be actioned even when the COM object is being hosted by an external client such as VB. However this is a Smalltalk debugger, and one cannot use it to debug into external code written in other languages.
Caution: Although modifying the Debugger can be fun it is quite easy to crash the system if a mistake is made. You should also note that if you develop your own custom view the use of a virtual ListView for the stack presenter is not recommended since the stack may change dynamically and become momentarily invalid at just the point that the control requests display details.
Instance Variables:
process <Process> being debugged.
topFrame <StackFrame> which is at the top of the debugger''s stack.
temp <Object> the contents of the currently selected instance variable.
tempCount <integer> count of temporaries in the currently selected stack frame.
depth <integer> count of stack frames currently listed.
flags <integer> flags controlling the debugger''s behaviour.
breakWhen <monadicValuable> used to determine the next execution should be interrupted.
stackPresenter <ListPresenter> used to display the stack frames.
sourcePresenter <SmalltalkWorkspace> holding the source/this assembly of the selected frame.
tempsPresenter <ListPresenter> holding the list of temporaries in the selected frame.
inspectorPresenter <SmalltalkWorkspace> holding the value of the selected temporary variable.
breakAction <niladicValuable>. The second half of a composite action to be performed after an unwind.
suspendingList <Semaphore> on which debugged process was suspended when interrupted (or nil if none).
Class Variables:
AnimateMask <integer> bit-mask for testing/setting the animation flag
AnimatePause <integer> delay between steps when animating.
DefaultStackDepth <integer> initial depth of the process stack display
DisassemblyMask <integer> bit-mask for testing/setting the disassembly view flag
EnableDynamicMenus <boolean> option controlling whether dynamic menus are build and displayed or not.
MainMask <integer> bit-mask for testing/setting the main Process flag
RestartOnMethodSave <boolean> option controlling whether saving a modified method restarts the frame
ResumableMask <integer> bit-mask for testing/setting the resumable Process flag
RunMask <integer> bit-mask for testing/setting the running flag.
ShowWalkbacks <boolean> option controlling whether walkback dialogs are displayed or not
SkipMethods <LookupTable> of methods not to break in.
StackDepthIncrement <integer> number of frames by which to increase the depth of the stack on request.
TerminateOnClose <Symbol>. Option controlling action on closing debugger in respect of the debugged process.
'!
!Debugger class methodsFor!
animatePause
"Answer the number of milliseconds that instances of the receiver will pause between each step when
animating debugged processes."
^AnimatePause!
animatePause: milliseconds
"Set the number of milliseconds that instances of the receiver will pause between each step when
animating debugged processes."
AnimatePause := milliseconds!
debugPrintStringFor: anObject
"Private - Answer the debugging string representation of the argument."
^[anObject debugPrintString] on: Error
do: [:ex | 'an invalid ' , anObject basicClass name , ' {' , ex description , '}']!
defaultStackDepth
^DefaultStackDepth!
defaultStackDepth: anInteger
DefaultStackDepth := anInteger!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Debugger'
!
enableDynamicMenus
"Answer whether dynamic menus can be used in instances of the receiver. These can be
disabled to allow the dynamic menu framework to be debugged more easily."
^EnableDynamicMenus!
enableDynamicMenus: aBoolean
"Set whether dynamic menus can be used in instances of the receiver. These can be
disabled to allow the dynamic menu framework to be debugged more easily."
EnableDynamicMenus := aBoolean!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Initialize the class variables of the receiver
self initialize
"
StackDepthIncrement := 10.
DefaultStackDepth := 40.
MainMask := 16r1.
RunMask := 16r2.
DisassemblyMask := 16r4.
ResumableMask := 16r8.
AnimateMask := 16r10.
AnimatePause := 200.
self restartOnMethodSave: true.
self enableDynamicMenus: true.
self showWalkbacks: true.
"The behaviour in versions of Dolphin prior to 4.0 was to always terminate processes on closure of the debugger"
self terminateOnClose: #yes.
Smalltalk developmentSystem registerTool: self.
self initializeSkipTable!
initializeSkipTable
"Initialize the table of methods to be skipped (in one way or another) when debugging.
Debugger initializeSkipTable
The idea of the skip table is to prevent the implementation of certain parts of the system
(e.g. exception handling) from surfacing unduly when debugging - i.e. one doesn't want
to repeatedly step through system code. The debugger may be instructed to step over
individual methods in one of several ways according to the skip type, which is a bit mask:
0 - Does not break in the method itself, but will step into subsidiary methods.
1 - Does not break in the method or any of its subsidiary methods.
2 - The method is a critical section and cannot be safely debugged. Do not stop regardless of mode.
"Set the model value of the receiver to be anObject"
self model value: anObject.
! !
InspectorShell comment:
'InspectorShell is a <SmalltalkToolShell> that implements the various inspector tools. Note that this is really just a "shell" around the real functionality which is obtained by embedding one of a number of <Inspector> presenters. The particular <Inspector> subclass chosen is determined by the type of the object being inspected.
'!
!InspectorShell class methodsFor!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Inspector'
!
icon
"Answers an Icon that can be used to represent this class"
^BasicInspector icon! !
!InspectorShell methodsFor!
initialize
"Private - Initialize the receiver"
super initialize.
self hasCommandHistory: true! !
LiveUpdate comment:
'LiveUpdate is a <topPresenter> used by the development system to install live updates (patches) into the image.
Instance Variables:
updates <ListPresenter> holding <Associations> describing the updates available for this image.
status <TextPresenter> describing the current state of the Live Update process.
isOnline <boolean> indicating whether the update site can be contacted.
connectionIcon <ImagePresenter> holding an icon that indicates the connection state.
'MethodBrowserShell is a <SmalltalkToolShell> that implements a method browser tool in a top-level window. Note that this is really just a "shell" around the real functionality which is obtained by embedding a <MethodBrowser> presenter.
Instance Variables:
browserPresenter <MethodBrowser> browsing the list of methods.
'PackageBrowserShell is a <SmalltalkToolShell> that implements the Package Browser tool. This provides a user interface onto all the <Package>s held by the current <PackageManager>.
Instance Variables:
packagesPresenter <ListPresenter> holding the list of currently loaded packages.
classesPresenter <ListPresenter> displaying the list of classes in the selected package.
methodsPresenter <ListPresenter> displaying the list of explicit methods in the selected package.
globalsPresenter <ListPresenter> displaying the list of globals in the selected package.
resourcesPresenter <ResourceListPresenter> displaying the list of resources in the selected package.
scriptsPresenter <ListPresenter> displaying a list of scripts for the selector package.
sourceMode <Symbol> indicating the current source mode, #class, #method, #global, #resource, #script.
sourcePresenter <SmalltalkWorkspace> displaying the source for the currently selected package object.
commentPresenter <SmalltalkWorkspace> displaying the package comment.
inspectorPresenter <PublishedAspectInspector> inspecting the selected package.
^self resourceIdentifiers select: [:each | each resource isViewResource]! !
ProtocolBrowserShell comment:
'ProtocolBrowserShell is a <SmalltalkToolShell> that implements the Protocol Browser tool. This displays a list of all the <MethodProtocol>s known to the system. Selecting a protocol displays the selectors within it and the classes that conform to it. From within the Protocol Browser it is possible to perform a wide range of protocol housekeeping activities.
Instance Variables:
protocolsPresenter <ListPresenter> holding the list of installed protocols.
selectorsPresenter <ListPresenter> holding a list of messages for the selected protocol.
classesPresenter <ListPresenter> holding a list of classes conforming to be selected protocol.
'ResourceBrowser is a <SmalltalkToolShell> that implements the Resource Browser tool. This provides an interface onto all the <Resource>s held by the current <ResourceManager>.
Instance Variables:
resourceListPresenter <ResourceListPresenter> displaying the current list of resources.
resourceTree <UndefinedObject> not used.
packagesPresenter <ListPresenter> displaying a list of all the current packages.
'!
!ResourceBrowser class methodsFor!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Resource Browser'
!
icon
"Answers an Icon that can be used to represent this class"
^Resource icon!
initialize
"Private - Register the receiver with SmalltalkSystem.
self initialize
"
Smalltalk developmentSystem
addSystemFolderIcon: self toolsFolderIcon;
registerTool: self.
self reuseIfOpen: true.!
publishedAspects
"Answer a <LookupTable> of the <Aspect>s published by the receiver."
| aspects |
aspects := super publishedAspects.
aspects add: (Aspect boolean: #reuseIfOpen).
^aspects!
show
"Shows the view of the receiver.
Pick up the default extent if any."
| browser |
browser := super show.
browser showAllResources.
^browser!
showAsToolboxFor: aView at: aPoint
"Creates an instance of the receiver in a toolbox view attached to aView
and displayed at aPoint relative to the origin of this view"
"Private - The receiver has changed in such a way that the caption may need to be refreshed."
| strm |
strm := String writeStream.
strm
display: self class;
nextPutAll: ' - ';
nextPutAll: resourceListPresenter caption.
self caption: strm contents! !
SmalltalkSystemShell comment:
'SmalltalkSystemShell is a <SmalltalkToolShell> that implements the user interface onto theDolphin Smalltalk system folder. This an iconic daunting point for all of the installed tools, sample applications etc.
Instance Variables:
systemFolderPresenter <FolderPresenter> displaying the system folder hierarchy.
Class Variables:
Default <SmalltalkSystemShell> which is the singleton instance.
DefaultBackcolor <color> for the background of the folder.
'!
!SmalltalkSystemShell class methodsFor!
applyOptions
self allSubinstances do: [:each | each applyOptions]!
default
"Answer the default instance of the receiver
SmalltalkSystemShell default
"
Default isNil ifTrue: [
Default := self show ].
^Default!
defaultBackcolor
"Answe the default background to use for instances of the receiver"
^DefaultBackcolor!
defaultBackcolor: aColorOrNil
"Set the default background to use for instances of the receiver"
DefaultBackcolor := aColorOrNil.
self applyOptions!
defaultPosition
"Private - Answer the default location of the receiver"
^22@22!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'System Folder'!
free
"Close and release the current system shell (e.g. to create a runtime image).
Also close the associated Transcript"
Default notNil ifTrue: [
TranscriptShell free.
Default view destroy ].
Default := nil!
icon
"Answers an Icon that can be used to represent this class"
^Smalltalk developmentSystem icon!
initialize
"Private - Initialize the receiver's class variables.
self initialize
"
Smalltalk developmentSystem registerTool: self.
self defaultBackcolor: (RGB
red: 20
green: 104
blue: 194) faded.
self viewMode: #tileIcons.
self playSystemSounds: true!
onStartup
"Private - The development system is starting, perform initialization actions.
Sent after windows are restored."
"Cause the desktop icon title font to be picked up correctly"
SmalltalkSystem current defaultFont isNil ifTrue: [SmalltalkSystem current defaultFont: nil].
"Update the SmalltalkSystemShell caption to show current image file name. This
may have changed if the .img/.exe has been copied outside of Dolphin.
Have to perform this after windows have been recreated or else they
will just show the caption when the image was saved."
self default updateCaption.
!
playSystemSounds
"Answer true if the IDE sounds are turned on"
^PlaySystemSounds
!
playSystemSounds: aBoolean
"Sets wherher the IDE sounds are turned on"
PlaySystemSounds := aBoolean
!
publishedAspects
"Answer a <LookupTable> of the <Aspect>s published the receiver."
"Update the <OrderedCollection>, path, with the receiver's contribution to the
command path held by the <CommandPolicy>, route. Answer self to have the command
policy decide where to go next.
Implementation Note: We want to include the development system if it is present."
super addToCommandRoute: route.
route appendTarget: Smalltalk developmentSystem
!
callbackResetList
self
resetListFromModel;
setResultDisplay!
callbackSelectedItems: aCollection!
callbackToggledUseDisplayNames
self refreshList!
createComponents
"Create the presenters contained by the receiver. At this stage
the receiver has not yet been initialized."
super createComponents.
self labelTextPresenter: (
self
add: TextPresenter new
name: 'label').
self listPresenter: (
self
add: ListPresenter new
name: 'list').
self statusTextPresenter: (
self
add: TextPresenter new
name: 'status')
!
createSchematicWiring
"Create the trigger wiring for the receiver. At this stage the initialization
is complete and the view is open"
super createSchematicWiring.
self listPresenter
when: #selectionChanged
send: #selectionChanged
to: self;
when: #actionPerformed
send: #browseHierarchy
to: self!
delete
self model removeSelectedInList!
helpAbout
MessageBox
notify: self helpString
caption: 'About ', self browserName!
helpString
| stream|
stream := WriteStream on: (String new: 50).
^stream
nextPutAll: self browserName;
nextPutAll: ' for Dolphin Smalltalk 4.0/5.0';
cr;
cr;
nextPutAll: 'Version 3.1 PR14';
contents
!
label
^self labelTextPresenter view!
labelTextPresenter
"Private - Answer the value of the receiver's ''labelTextPresenter'' instance variable."
^labelTextPresenter!
labelTextPresenter: anObject
"Private - Set the value of the receiver's ''labelTextPresenter'' instance variable to the argument, anObject."
labelTextPresenter := anObject!
listModel
^listModel!
listModel: anObject
listModel := anObject!
listPresenter
^listPresenter!
listPresenter: anObject
listPresenter := anObject!
queryCommand: aCommandQuery
"Enters details about a potential command for the receiver into aCommandQuery"
super queryCommand: aCommandQuery.
(aCommandQuery command = #delete)
ifTrue: [aCommandQuery isEnabled: self model canRemove].
(aCommandQuery command = #useDisplayNames)
ifTrue: [aCommandQuery isChecked: self model useDisplayNames].
!
refreshItemAtIndex: anIndex
listModel updateAtIndex: anIndex
!
refreshList
1
to: self listModel size
do: [:index | self refreshItemAtIndex: index].
self view update !
refreshList: aCollection
self view update !
reset
self model buildList!
selectionChanged
self setModelWithSelectedItems
!
setDetailState
| wrapper |
wrapper :=
SUnitStatusTextWrapper
newOn: self model detailState
model: self model.
self statusTextPresenter value: wrapper !
setResultDisplay
self
setLabelState;
setDetailState!
setStatusColorsOn: aWidget
| labelColor |
labelColor := Color perform: self model resultStateColorSymbol.
"a little hack - green on Dolphin is pretty yucky"
labelColor index = 16777230
ifTrue: [labelColor := IndexedColor darkGreen].
self model showStatusBackgroundColors
ifTrue: [
aWidget
backcolor: labelColor;
forecolor: Color white]
ifFalse: [
aWidget
backcolor: Color white;
forecolor: labelColor]!
status
^self statusTextPresenter view!
statusTextPresenter
"Private - Answer the value of the receiver's ''statusTextPresenter'' instance variable."
^statusTextPresenter!
statusTextPresenter: anObject
"Private - Set the value of the receiver's ''statusTextPresenter'' instance variable to the argument, anObject."
statusTextPresenter := anObject!
testCaseSelectionChanged
self setModelWithSelectedTestCases
!
useDisplayNames
self model toggleUseDisplayNames! !
TipOfTheDay comment:
'TipOfTheDay is a <SmalltalkToolShell> that implements a window displaying helpful usage tips about Dolphin Smalltalk. The tips are taken from a number of .tip files found in the Resources directory. Addtional tip files can be added if necessary; the files contain one tip per line and each tip may have HTML formatting if desired.
The development system is initially configured to display the TipOfTheDay window at image startup (after the splash screen has been dismissed). This can be turned on or off from within the TipOf TheDay window or by using the system options for this tool. A TipOfTheDay is also available at any time from the Help/Tip of the Day menu command.
Instance Variables:
tipText <URLPresenter> displaying the current tip as HTML.
showTipsAtStartup <BooleanPresenter> indicating whether the tip window should appear at startup.
tipsFile <ChoicePresenter> indicating the name of the tips file to use.
Class Variables:
TipsFile <readableString> indicating the name of the current tips file.
ShowTipsAtStartup <boolean> indicating whether the tip window will appear at startup.
TipIndex <SmallInteger> holding the index of the current tip within tips file.
"Send the primary selection to the back of the Z-order."
| editee |
editee := self primarySelection.
editee zOrderBottom.
self zOrderChangedFor: editee.
!
zBackward
"Move the primary selection down one place in the Z-order."
| nextSibling editee |
editee := self primarySelection.
nextSibling := editee nextSiblingView.
nextSibling notNil ifTrue:
[editee zOrderAfter: nextSibling].
self zOrderChangedFor: editee.
!
zForward
"Move the primary selection up one place in the Z-order."
| sibling editee |
"We can only Zposition a view AFTER a specified sibling.
So, locate the sibling two places in front and Zposition
the receiver after it."
editee := self primarySelection.
sibling := editee previousSiblingView.
sibling notNil ifTrue:
[sibling := sibling previousSiblingView.
sibling notNil ifTrue:
[editee zOrderAfter: sibling]].
sibling isNil ifTrue:
[editee zOrderTop].
self zOrderChangedFor: editee!
zFront
"Bring the primary selection to the front of the Z-order."
| editee |
editee := self primarySelection.
editee zOrderTop.
self zOrderChangedFor: editee.
!
zOrderChangedFor: aView
"Private - The ZOrder position of aView has been changed. Inform the
view hierarchy model so that its views update appropriately"
viewHierarchy model move: aView asChildOf: (viewHierarchy model parentOf: aView).
! !
ClassBrowserShell comment:
'ClassBrowserShell is a <SmalltalkToolShell> implementing the Class Hierarchy Browser development tool.
ClassBrowserShell has two views:
1. ''Default view'' which is the standard view and is aware of new features such as method protocols. It can also filter methods by the instance variables they reference. It has dynamic menus for browsing references and definitions and certain other useful features.
2. ''Basic class browser'' which is similar to the pre-3.0 CHB (but supporting history buttons). If you have a slow machine, or one with limited screen area (e.g. 640x480), you may want to use this browser. It can be started from an icon in the Additional Tools folder or from the Tools menu.
[ClassBrowserShell formerly had a ''Moening class browser'' view, which was the same as the ''Default view'', but with the standard Windows <TreeView> control replaced by a <MoenTreeView>. This has been superceded by the Class Diagram plugin]
Note that this is a rather good example of the flexibility of MVP. All views are supported by the same <presenter> class, with very little conditional code (what little there is is required for the Basic class browser because it does not have all of the sub-views present in the other two browsers). Another interesting property of the CHB is that it shares the <MethodBrowser> presenter with the <MethodBrowserShell>, and yet you will note that the CHB interpretation of this view is quite a different shape.
Instance Variables:
None.
Class Variables:
LocalHierarchyMask <integer> mask flag for the local hierarchy mode.
'!
!ClassBrowserShell class methodsFor!
displayOn: aStream
"Append, to aStream, a String whose characters are a representation of the receiver as a user
would want to see it."
aStream nextPutAll: 'Class Browser'!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
initialize
"Private - Initialize the receiver's class variables.
ifTrue: [aCommandQuery isChecked: self model showStatusBackgroundColors]!
resetListFromModel
self listModel
removeAll;
addAll: self wrapAllTestResourcesFromModel
!
setLabelState
!
setModelWithSelectedItems
self model selectItems: (self listPresenter selection asOrderedCollection collect: [:each | each testResource])
!
startAll
self model startAll!
startSelected
self model startSelected!
stopAll
self model stopAll!
stopSelected
self model stopSelected!
wrapAllTestResourcesFromModel
^self model listItems collect: [:each | SUnitTestResourceWrapper newOn: each model: self model].
! !
ValueWorkspace comment:
'ValueWorkspace is a <valuePresenter> for displaying the contents of a <valueModel> using a <TextEdit> workspace view. ValueWorkspace allows Smalltalk expressions to be entered and, when Accepted, the result of the evaluation is stored back to the model. ValueWorkspace is used as a fundamental part of the PublishedAspectInspector.
Note that this is a somewhat unusual MVP triad; the ValueWorkspace model is not connected directly to the view. Instead, the view is redirected (via #viewModel) to another model that holds the textual rendition of the actual model.
Instance Variables:
textModel <ValueHolder> holding the textual rendition of the model''s value.
'!
!ValueWorkspace class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^nil asValue!
initialize
"Private - Initialize the receiver's class variables.
self initialize
"
ValueIsSelfCookie := Object new! !
!ValueWorkspace methodsFor!
accept
"Accept changes to the receiver by evaluating it, and setting the result into
the associated model. If there is no selection, then the entire contents of the
"Set the model value of the receiver to be anObject"
self model value: anObject.
!
viewModel
"Private - Answer the model that is to be connected to the view. It is actually
connected to the receiver's textModel - not the receiver's value model"
^textModel! !
AcceleratorPresenter comment:
'AcceleratorPresenter is a <valuePresenter> that displays a <valueModel> onto an <integer> key code that represening an accelerator key depression. Normally, an AcceleratorPresenter is connected to a <HotKey> view.'!
!AcceleratorPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^0 asValue!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
BasicInspector comment:
'BasicInspector is a <compositePresenter> that implements a generic inspect facility onto any <Object>.
Example:
SmalltalkSystem current basicInspect
Instance Variables:
variableNamesPresenter <ListPresenter> presenting the instance variables of the inspected object.
sourcePresenter <SmalltalkWorkspace> for displaying the selected variable values.
'!
!BasicInspector class methodsFor!
headerList
"Answer an OrderedCollection of associations between prefix attributes and selectors
to be sent to instances of the receiver to access those attributes."
^##(OrderedCollection with: 'self' -> #selfField)
!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon!
publishedEventsOfInstances
"Answer a Set of Symbols that describe the published events triggered
by instances of the receiver."
^super publishedEventsOfInstances
add: #inspecteeChanged;
yourself.
!
shellOn: anObject
"Open an Inspector shell displaying on anObject.
Answer the new Inspector."
| inspector shell |
shell := InspectorShell create.
shell caption: self displayString , ' on ', anObject basicPrintString.
inspector := self createIn: shell on: (ValueHolder with: anObject).
inspector view arrangement: #center.
shell view validateLayout.
shell show setInitialFocus.
^inspector! !
!BasicInspector methodsFor!
accept
"Saves the current source as the value of the selected variable of the
receivers object."
variableNamesPresenter hasSelection
ifTrue:
["If there is no selection then the entire workspace is selected for consistency
with saving method source. This also works rather better with word wrap too."
"Private - Answer the index of the variable associated with the curently
selected variable name of the receivers object or 0 if there is no selection."
^variableNamesPresenter selectionByIndex!
variableName
"Private - Answer the selected variable name of the receivers object."
^variableNamesPresenter selectionOrNil!
variableName: name
"Private - Select the variable name of the receivers object."
variableNamesPresenter selection: name!
variableNamesList
"Answer an OrderedCollection of all the names of the currently
inspected objects variables."
^variableNamesPresenter list! !
BooleanPresenter comment:
'BooleanPresenter is a <valuePresenter> that displays a <valueModel> onto a <boolean> value. A BooleanPresenter can be connected to any <valueView> capable of displaying <boolean> values. Often, this will be a <CheckBox> although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!BooleanPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^false asValue!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
ChoicePresenter comment:
'ChoicePresenter is <valuePresenter> which allows a value to be chosen from a list of alternatives. The range of choices may be supplied as any <sequencedCollection> by using the #choices: method once the ChoicePresenter has been instantiated. The initial selection in the visible list will match the initial value in the ChoicePresenter''s <valueModel>. As different selections are made in list they are transferred directly into the associated model.
By default, a ChoicePresenter allows single selection choices to be made. It is also possible, however, to allow multiple selections by attaching an appropriate <listView> supporting the <multipleSelectableItems> protocol. In this case, the value held by the model will be an <Array> of the chosen items.
It is also sometimes useful to specify one of the supplied choices as being able to represent a nil value in the model. This can be done by using the #nilChoice: method.
"The receiver's value has changed. Ensure that we update the list selection to match"
self updateChoice.
super onValueChanged
!
updateChoice
"Private - The value has been changed in the receiver's model.
Transfer the value to the list view's selection."
self view selectionOrNil: (self value ifNil: [nilChoice])!
view: aView
"Set the view for the receiver to aView. This should be overidden for composites
to also connect up any sub-views"
super view: aView.
"Transfer the choice selection across to the associated list. Beware though;
under some circumstances the choices model may not yet have been filled."
choicesModel notEmpty ifTrue: [
self updateChoice ]!
viewModel
"Private - Answer the model that is to be connected to the view. It is actually
connected to the receiver's choicesModel - not the receiver's value model"
^choicesModel! !
CollectionPresenter comment:
'CollectionPresenter is a <valuePresenter> that presents a <Collection> accessed via its <valueModel>. It provides a number of [operations]for editing the list. As changes are made to the list it is applied back to the presenter''s <valueModel>.
Instance Variables:
listPresenter <ListPresenter> presenting the list accessed as the value of the presenter''s model.
'!
!CollectionPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^OrderedCollection new asValue!
icon
"Answers an Icon that can be used to represent this class"
^##(self) instanceClass defaultIcon! !
!CollectionPresenter methodsFor!
addItem
"Uses the receiver's addItemBlock to answer a new item to add to the collection"
"Removes the current selection from the receiver's list"
| index |
index:= listPresenter selectionByIndex.
self listModel removeAtIndex: index.
listPresenter selectionByIndex: (index min: listPresenter model size)!
setAddItemBlock: aNiladicValuable
"Set the block to evaluate when adding new items to the receiver's collection"
addItemBlock := aNiladicValuable! !
ColorPresenter comment:
'ColorPresenter is a <valuePresenter> that displays a <valueModel> onto a <color> value. A ColorPresenter can be connected to any <valueView> capable of displaying <color> values. Normally, this will be a <ColorView> although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!ColorPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^Color black asValue!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
DatePresenter comment:
'DatePresenter is a <valuePresenter> that displays a <valueModel> onto a <Date> value. A DatePresenter can be connected to any <valueView> capable of displaying <Date> values. Normally, this will be a <DateTimePicker> although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!DatePresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^Date today!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
FontPresenter comment:
'FontPresenter is a <valuePresenter> that displays a <valueModel> onto a <Font> value. A FontPresenter can be connected to any <valueView> capable of displaying <Font> values. Normally, this will be a <FontView> although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!FontPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^Font system asValue!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
ImagePresenter comment:
'ImagePresenter is a <valuePresenter> that displays a <valueModel> onto an <image> value. A ImagePresenter can be connected to any <valueView> capable of displaying <image> values. Normally, this will be an <ImageView> or <StaticImage>, although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!ImagePresenter class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
InspectorAbstract comment:
''!
!InspectorAbstract class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^BasicInspector icon!
imageForAspect: anAspectAccessor
^([anAspectAccessor valueIcon] on: Error do: [:ex | ex icon]) imageIndex!
textForAspect: anAspectAccessor
| aStream |
aStream := String writeStream: 40.
[anAspectAccessor displayOn: aStream] on: Error do: [:ex |
aStream basicPrint: ex].
" ex displayOn: aStream]."
^aStream contents! !
!InspectorAbstract methodsFor!
browseClass
"Private - Open a new default browser on the class of the object being inspected."
self systemModel browseClass: self browseObject!
browseHierarchy
"Private - Open a new class browser on the class of the object being inspected."
"Private - Answer the object from the receiver that should be browsed"
^self inspecteeSelection class!
inspecteeSelection
"Private - Answer the value associated with the currently selected object"
^self subclassResponsibility!
inspectIt
"Open a new Inspector on the variable selected in variablesModel."
self inspecteeSelection inspect!
systemModel
^SmalltalkSystem current! !
NumberPresenter comment:
'NumberPresenter is a <valuePresenter> that displays a <valueModel> onto a <number> value. A NumberPresenter can be connected to any <valueView> capable of displaying <number> values. Often, this will be a <TextEdit> with a <NumberToText> converter installed although alternative views may be chosen after the installation of an appropriate <typeConverter>.'!
!NumberPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^0 asValue!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
TextPresenter comment:
'TextPresenter is a <valuePresenter> that displays a <valueModel> onto a <readableString> value. A TextPresenter can be connected to any <valueView> capable of displaying <readableString> values. Often, this will be a <TextEdit> although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!TextPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^String new asValue!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
!TextPresenter methodsFor!
clear
"Remove all contents in the receiver's view"
self value: ''!
dragOver: session
"The drag operation described by the <DragDropSession>, session,
has moved to a new position over the receiver's window. Use the session
to provide feedback to the user about allowable operations etc.
Implementation Note: Override this message to suggest a default drop action of
"Answer true if the receiver has a current selection"
^self view hasSelection!
isModified
"Answer whether the text in the receiver's model has been modified."
^self view isModified!
isModified: aBoolean
"Set/reset the receiver's dirty flag."
self view isModified: aBoolean!
onTextOverflow
"Default handler for EN_MAXTEXT notification. Can be overridden, but the
preferred customization route is to observe the #textOverflow event."
^self view onTextOverflow!
replaceSelection: aString
"Replace the current selected range of text with aString"
^self view replaceSelection: aString!
selectionRange
"Answers an interval identifying the selected range of text"
^self view selectionRange!
selectionRange: anInterval
"Sets anInterval to be the selected range of text"
^self view selectionRange: anInterval
! !
TimePresenter comment:
'TimePresenter is a <valuePresenter> that displays a <valueModel> onto <Time> value. A TimePresenter can be connected to any <valueView> capable of displaying <Time> values. Normally, this will be a <DateTimePicker> although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!TimePresenter class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^##(self) defaultIcon! !
URLPresenter comment:
''!
!URLPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^'about:blank' copy asValue!
defaultView
"Answer the resource name of the default view for the receiver."
^'Internet Explorer'! !
AXInspector comment:
'AXInspector is a <compositePresenter> that implements a specialised inspect facility onto a <IDispatch>. This attempts to display the IDispatch properties.
'CompiledMethodInspector is a <compositePresenter> that implements a specialised inspect facility onto a <CompiledMethod>. This provides additional functionality to view the source, and the decompiled bytecodes.'!
!CompiledMethodInspector class methodsFor!
headerList
"Answer an OrderedCollection of associations between prefix attributes and selectors
to be sent to instances of the receiver to access those attributes."
^##(self instanceClass superclass headerList,
(OrderedCollection
with: ' - source' -> #sourceText
with: ' - disassembly' -> #disassemblyText))!
initialize
"Private - Initialize the receiver's class variables.
self initialize
"
MethodTypes := #(
'Normal'
'Return nil'
'Return true'
'Return false'
'Return literal constant 0'
'Return self'
'Return instance variable'
'Set instance variable').
! !
!CompiledMethodInspector methodsFor!
disassemblyText
"Private - Answer a text decoding of the receivers byte codes."
^self selfField disassembly!
source
"Answer the text source of the receiver."
^self selfField getSource!
sourceText
"Private - Answer the text source of the receiver."
^self selfField getSource!
text
"Private - Answer the text to be displayed for the selected field."
| field index |
field := self variable.
index := self variableIndex.
^(index between: 2 and: self headerSize)
ifTrue: [ field ]
ifFalse: [ field printString ]! !
DictionaryInspector comment:
'DictionaryInspector is a <compositePresenter> that implements a specialised inspect facility onto a <Dictionary>. This provides additional functionality to inspect the dictionary via its keys and also to allow the user to add new keys and values.'!
!DictionaryInspector methodsFor!
addField
"Request a new key to add to the inspected object. If no matching key exists
in the object add the key with a value of nil, else just hilight the existing
'SequenceableCollectionInspector is a <compositePresenter> that implements a specialised inspect facility onto a <SequenceableCollection>. This allows the collection to be inspected via its integer indices.'!
!SequenceableCollectionInspector methodsFor!
getField: anInteger
"Private - Answer the field of the receiver's object which has the key at index
anInteger in the field list (1 based)."
| instSize |
instSize := self selfField class instSize.
^anInteger > instSize
ifTrue: [self selfField at: anInteger - instSize]
ifFalse: [self selfField instVarAt: anInteger]!
getFieldList
"Private - Answer the list of fields to be displayed in the instance variable list
of the inspector. Numeric indices for the elements of the collection are answered."
'StructureInspector is a <compositePresenter> that implements a specialised inspect facility onto a <ExternalStructure>. This allows the structure to be inspected via its name fields.'!
!StructureInspector methodsFor!
fields
"Private - Answer the of fields in the field list (named and indexable instance variables), which appear
after the inspectors header fields (accessors implemented by the inspector itself), and before
any extra fields (accessors implemented by the inspected object). Overridden because structure
inspectors do not include the raw data bytes."
^self selfField class instSize!
getField: anInteger
"Private - Answer the field of the receiver's object which has the key at index
anInteger in the field list (0 based)."
^self getFieldExtra: anInteger !
getFieldList
"Private - Answer the list of fields to be displayed in the instance variable list
of the InspectorShell. Numeric indices for the elements of the
OrderedCollection are answered"
^self selfField class allInstVarNames , self selfField getValidFields!
setField: anInteger to: anObject
"Private - Determine the field of the receiver's object which has the key at index
anInteger in the field list, and set its value to anObject."
ifFalse: [super setField: anInteger to: anObject]! !
HashedCollectionPresenter comment:
''!
!HashedCollectionPresenter methodsFor!
addElement: anObject
self value: ((self value)
add: anObject;
yourself)!
addItem: anObject
"Add anAssociation into the receiver's model"
self addElement: anObject.
self onValueChanged.
listPresenter selection: anObject!
canGrow
"Private - Answer true if it is valid to add and remove elements of the receiver's collection"
^self model canSet !
elements
^self value asSortedCollection: [:x :y | x displayString < y displayString]!
onListChanged
"The list of keys has been changed so update the receiver's model."
"Do nothing. Updates are handled by #addItem and #removeItem"
!
onValueChanged
"Private - The value has been changed in the receiver's model.
Transfer the value to the listModel"
listPresenter model: ListModel newEquality.
listPresenter list: self elements!
removeElement: anObject
self value: ((self value)
remove: anObject;
yourself)!
removeItem
"Removes the current selection from the receiver's list"
| item |
item := listPresenter selection.
self removeElement: item.
self onValueChanged! !
SequenceableCollectionPresenter comment:
'SequenceableCollectionPresenter is a <valuePresenter> that presents a <sequencedCollection> accessed via its <valueModel>. It provides a number of [operations]for editing the list. As changes are made to the list it is applied back to the presenter''s <valueModel>.
'!
!SequenceableCollectionPresenter methodsFor!
canReorder
"Private - Answer true if it is valid to reorder the receiver's collection"
^self model canSet and: [self model value class conformsToProtocol: #sequencedCollection]!
moveDown
"Moves the current selection closer to the end of the receiver's list"
| index list |
index := listPresenter selectionByIndex.
list := self listModel.
list swap: index with: index + 1.
listPresenter selectionByIndex: index + 1!
moveFirst
"Moves the current selection to be the first item in the receiver's list"
| list index |
index := listPresenter selectionByIndex.
list := self listModel.
list noEventsDo:
[| item |
item := list at: index.
list replaceFrom: 2 to: index with: list startingAt: 1.
list at: 1 put: item].
list notifyListChanged.
listPresenter selectionByIndex: 1!
moveLast
"Moves the current selection to be the last item in the receiver's list"
| list index last |
index := listPresenter selectionByIndex.
list := self listModel.
last := list size.
list noEventsDo:
[| item |
item := list at: index.
list
replaceFrom: index
to: last - 1
with: list
startingAt: index + 1.
list at: last put: item].
list notifyListChanged.
listPresenter selectionByIndex: last!
moveUp
"Moves the current selection closer to the head of the receiver's list"
| index list |
index := listPresenter selectionByIndex.
list := self listModel.
list swap: index with: index - 1.
listPresenter selectionByIndex: index - 1!
onValueChanged
"Private - The value has been changed in the receiver's model.
Transfer the value to the listModel"
listPresenter list: self value!
queryCommand: query
"Private - Enters details about a potential command for the receiver into
"Private - Set the value associated with the currently selected
instance variable name to anObject."
self aspectAccessor value: anObject.
self inspecteeChanged!
unableToDisplayVariableErrorFormatString
"Private - Answer the format string used to construct the error message text to be
displayed in place of a variable value when a variable is selected that cannot be
printed."
^'an invalid %2 [%3]%n%nEvaluate the following expression to debug:%n self printString'
! !
PublishedAspectInspector comment:
'PublishedAspectInspector is a <compositePresenter> that displays, and allows the modification of, a hierarchy of the published <Aspect>s for its model.
In order that the PublishedAspectInspector can display the aspects of a particular object, they must first be published by the object''s class. This is generally done by implementing the class side method, #publishedAspectsOfInstances, to add each of the <Aspect>s that need to be published to a <Set>. In certain specialised cases it may also be necessary to override the instance side method, #publishedAspects, in order to adjust this set by adding or removing aspects that are not discernible on the class side alone. If no aspects are explicitly published by the above means then any
public instance variable accessor methods are published by default (see Object>>publicAccessorAspect).
Typically, a PublishedAspectInspector is used as one of the renditions in the FlipperInspector and the main attribute editor in the View Composer. However, you''ll find it used in other places in the development image, such as for editing "Pool Dictionaries" and "Dolphin Options" within the main system folder.
'RichTextPresenter is a <valuePresenter> that displays a <valueModel> onto a <richString> value. A RichTextPresenter can be connected to any <valueView> capable of displaying <richString> values. Often, this will be a <RichTextEdit> although alternative views may be chosen with the installation of an appropriate <typeConverter>.'!
!RichTextPresenter class methodsFor!
defaultModel
"Answer a default model to be assigned to the receiver when it
is initialized."
^String new asRichText asValue! !
!RichTextPresenter methodsFor!
alignParagraphCenter
"Align the receiver's paragraph selection to centre"
self view paragraphAlignment: #center!
alignParagraphLeft
"Align the receiver's selection paragraph to the left"
self view paragraphAlignment: #left!
alignParagraphRight
"Align the receiver's paragraph selection to the right"
self view paragraphAlignment: #right!
bePlain
"Set the selection in the receiver to plain text"
self view bePlain!
chooseSelectionColor
"Choose the color for the selection in the receiver"
'CaseInsensitiveSearchPolicy is for configuring pluggable collections and models of strings to use case-insensitive equality based search and comparisons, i.e. using #sameAs: and the #hash of the lowercased equivalent of the string.
N.B. Unlike other SearchPolicy classes, instances of this class are only appropriate for comparing and searching collections of strings, or objects which can be represented as strings (i.e. implementors of #asString).
'!
!CaseInsensitiveSearchPolicy methodsFor!
compare: operand1 with: operand2
"Answer whether the <Object>, operand1, is considered equivalent to the <Object> argument,
operand2, by this search policy."
^operand1 asString sameAs: operand2 asString!
hash: operand
"Answer a suitable hash value for the <Object>, operand, under this search policy."
^operand asString asLowercase hash!
keyAtValue: value in: collection ifAbsent: operation
"Answer the <Object> key of the <Object> argument, value in the keyed
collection, collection, using the receiver's search policy. If there is no such
value, answer the result of evaluating the <niladicValuable>, operation.
The reverse mapping identity search operation is used: The collection argument
must respond to #keysAndValuesDo: (there is no keyedCollection protocol
'CompiledMethodSearchPolicy is a specialised <searchPolicy> to be used in conjunction with collections of <CompiledMethod>s where one wishes to compare by class and selector only. This is used in the development system for most method lists.'!
!CompiledMethodSearchPolicy class methodsFor!
current
"Answer the singleton instance of the receiver."
Current isNil ifTrue: [Current := self new].
^Current!
onPreStripImage
"Private - Tidy up the receiver's lazily initialized class vars in preparation for image stripping."
self uninitialize!
uninitialize
"Private - Tidy up the receiver in preparation for removal from the system."
Current := nil! !
!CompiledMethodSearchPolicy methodsFor!
compare: operand1 with: operand2
"Answer whether the <CompiledMethod>, operand1, is considered equivalent to the
<CompiledMethod> argument, operand2, by this search policy (which considers two
method to be the same if they are for the same class and have the same selector)."
'EqualitySearchPolicy is for configuring pluggable collections and models to use equality based search and comparisons, i.e. using #= and #hash, etc. Using an instance of this search policy a <PluggableSet> will behave in the same way as a <Set>.'!
!EqualitySearchPolicy methodsFor!
compare: operand1 with: operand2
"Answer whether the <Object>, operand1, is considered equivalent to the <Object> argument,
operand2, by this search policy."
^operand1 = operand2!
hash: operand max: maximum
"Answer a suitable hash value for the <Object>, operand, under this search policy,
between 1 and the <integer>, maximum.
Implementation Note: Override to avoid a message send (seems trivial but performance
of search policies can be important)."
^operand hash \\ maximum + 1!
keyAtValue: value in: collection ifAbsent: operation
"Answer the <Object> key of the <Object> argument, value in the keyed
collection, collection, using the receiver's search policy. If there is no such
value, answer the result of evaluating the <niladicValuable>, operation.
The reverse mapping equality search operation is used: The collection argument
must respond to #keyAtEqualValue:ifAbsent: (there is no keyedCollection protocol
defined at present)."
^collection keyAtEqualValue: value ifAbsent: operation!
nextIndexOf: anElement in: collection from: start to: stop
"Answer the index of the next occurrence of anElement in the <sequencedReadableCollection>
argument, collection, between startIndex and stopIndex inclusive. If there are no such occurrences,
answer 0."
^collection nextIndexOf: anElement from: start to: stop!
'IdentitySearchPolicy is for configuring pluggable collections and models to use identity based search and comparisons, i.e. using #== and #identityHash, etc. Using an instance of this search policy a <PluggableSet> will behave in the same way as an <IdentitySet>.'!
!IdentitySearchPolicy methodsFor!
compare: operand1 with: operand2
"Answer whether the <Object>, operand1, is considered equivalent to the <Object> argument,
operand2, by this search policy."
^operand1 == operand2!
hash: operand
"Answer a suitable hash value for the <Object>, operand, under this search policy."
^operand identityHash!
hash: operand max: maximum
"Answer a suitable hash value for the <Object>, operand, under this search policy,
between 1 and the <integer>, maximum.
Implementation Note: The identityHash range is limited to 16-bits, so we must scale for large
collections to avoid excessive collisions causing a dramatic fall off in performance."
'PluggableSearchPolicy is for configuring pluggable collections and models to use pluggable search and comparison operations, i.e. one can define new search policies as instances of this class without writing a new <SearchPolicy> class, however performance will suffer slightly.'!
!PluggableSearchPolicy class methodsFor!
new
"Instances of the receiver require that hashing and comparison valuables
be supplied - use newCompareBlock:hashBlock:"
^self shouldNotImplement!
newCompareBlock: discriminator hashBlock: hasher
"Answer a new instance of the receiver configured with the <dyadicValuable comparison block,
discriminator, and the <monadicValuable> hashing block, hasher."
^super new
compareBlock: discriminator hashBlock: hasher! !
!PluggableSearchPolicy methodsFor!
compare: operand1 with: operand2
"Answer whether the <Object>, operand1, is considered equivalent to the <Object> argument,
operand2, by this search policy."
^compareBlock value: operand1 value: operand2
!
compareBlock: discriminator hashBlock: hasher
"Set the <dynadicValuable> used by receiver to compare object to the
argument, discriminator. The discriminator should answer true if its two
arguments are considered equivalent under this search policy, else false.
Also set the <monadicValuable> used by the receiver to calculate hash values to the
argument, hasher. Answer the receiver."
compareBlock := discriminator.
hashBlock := hasher.
^self!
hash: operand
"Answer a suitable hash value for the <Object>, operand, under this search policy."
^hashBlock value: operand!
mapClass
"Private - Answer the class of <LookupTable> which has a compatible search policy."
^PluggableLookupTable!
newLookupTable
"Answer a new <LookupTable> with the receiver as its search policy."
^self mapClass searchPolicy: self! !
SymbolStringSearchPolicy comment:
'SymbolStringSearchPolicy is for configuring pluggable collections and models of <String>s or <Symbol>s such that the same sequence of characters compare as equal, regardless of whether the sequence is stored in a Symbol or a String. Normally Symbols are not considered equal to Strings even when they contain the same characters.
N.B. Unlike most other SearchPolicy classes, instances of this class are only appropriate for comparing and searching collections of Symbols and Strings (the objects to be compared must implement #hashCharacters and #trueCompare:).'!
!SymbolStringSearchPolicy class methodsFor!
current
"Answer the singleton instance of the receiver."
Current isNil ifTrue: [Current := self new].
^Current!
onPreStripImage
"Private - Tidy up the receiver's lazily initialized class vars in preparation for image stripping."
self uninitialize!
uninitialize
"Private - Tidy up the receiver in preparation for removal from the system."
Current := nil! !
!SymbolStringSearchPolicy methodsFor!
compare: operand1 with: operand2
"Answer whether the <Object>, operand1, is considered equivalent to the <Object> argument,
operand2, by this search policy."
^(operand1 trueCompare: operand2) == 0
!
hash: operand
"Answer a suitable hash value for the <Object>, operand, under this search policy."
'AssocationSearchPolicy is a specialized <EqualitySearchPolicy> for searching homogeneous collections of Associations by equality.
Association has traditionally implemented #hash as the has of its key only, and this leads to poor lookup performance in a standard <Set> where there are a lot of Associations with equal keys. This search policy can be used with <PluggableSet> and <PluggableLookupTable> to ameliorate this problem.'!
!AssociationSearchPolicy class methodsFor!
current
"Answer the singleton sub-instance of the receiver which supports a search policy
based on equality."
Current isNil ifTrue: [Current := super new].
^Current!
onPreStripImage
"Private - Tidy up the receiver's lazily initialized class vars in preparation for image stripping."
self uninitialize!
uninitialize
"Private - Tidy up the receiver in preparation for removal from the system."
Current := nil! !
!AssociationSearchPolicy methodsFor!
hash: operand
"Answer a hash value for the <Assocation>, operand, which takes account
of the value as well as the key (historically Association>>hash has answered the
hash of its key only, which makes it a poor Set element if a lot of the keys are the
same)."
^operand key hash bitXor: operand value hash!
hash: operand max: maximum
"Answer a suitable hash value for the <Object>, operand, under this search policy,
between 1 and the <integer>, maximum. If maximum is a significant proportion
of the range of hash values generated, then the result should be scaled to distribute
evenly between 1 and maximum in order to avoid generating excessive collisions at
the low end of the range."
^(operand key hash bitXor: operand value hash) \\ maximum + 1!
"Private - Pop-up a walkback with details from the argument, anException."
| title topFrame |
"Attempt to log the error, but don't allow it to become recursive (#logError: does not
raise an exception if it fails)"
self logError: anException.
[title := anException description]
on: Error do: [:e | title := anException class name].
topFrame := anException raisingFrame.
"In a development session, we'll be wanting a walkback..."
topFrame process walkback: title topFrame: topFrame resumable: anException isResumable
! !
ConsoleSessionManager comment:
'ConsoleSessionManager is the class of <SessionManager>s used to manage the life-cycle of a deployed console, or command-line, application.
The main entry point hook is the #main method. The program logic can be implemented entirely in #main in the case of simple applications, but it is recommended that a separate application class be constructed, with additional support classes as required. A console application normally exits when the #main method returns.
The standard C I/O streams, stdin/stdout/stderr, can be accessed by sending the #stdin, #stdout, and #stderr messages to the session. The resulting streams implement the full Smalltalk Stream protocols, and can be used interchangeably with normal streams. Furthermore these are connected to the actual C runtime library streams of the same name, and so calling C runtime library functions such as printf() (either from within Dolphin, or a DLL called from Dolphin) will result in output to the same console window. Note that these streams (and the console) are actually usable from <GUISessionManager>s too, which is useful for testing and debugging console applications from within the develoopment environment. The class side #run method provides a simple way to fire up a console application in the development environment, although the session manager is not actually installed.
A simple example of a console application is the command line version of the Hello World sample. Try it out be evaluating:
CommandLineHelloWorld run "Watch out for the appearance of the console, and press ENTER to continue"
'!
!ConsoleSessionManager class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^Icon fromId: 3 in: ShellLibrary default!
isRuntime
"Answer whether the sessions managed by instances of the receiver are for a run-time applications
(as opposed to development, or abstract)."
^true!
new
"Answer a new instance of the receiver. This is permited for ConsoleSessionManagers in order
to facilitate testing."
^self basicNew initialize;
initializeFromSessionManager: self current;
yourself!
run
"Test this console program.
self run
"
| consoleAlreadyOpen |
"As this is used from the development environment, we must make sure that a console has been allocated.
If we opened it just for this test, then we want to close it before finishing"
consoleAlreadyOpen := self current openConsole.
self new main.
consoleAlreadyOpen ifFalse: [self current closeConsole]! !
!ConsoleSessionManager methodsFor!
allocConsole
"Private - Open a console for this session."
"We already have one"!
basicTertiaryStartup
"Perform fundamental tertiary system startup operations."
self embeddedStartup!
freeConsole
"Private - Close (actually detach from) the console for this session.
In the case of a console app, we didn't allocate the console, so we don't
free it (even though to do so would be harmless)."
self assert: [consoleHandler isNil]!
isEmbedded
"Answer whether the session is running, or should be started, in 'embedded'
mode (i.e. headless). This is an embedded session in so far as it has no GUI."
^true!
logError: anException
"Append details about the unhandled exception, anException, to the session error log.
Ignored for runtime systems, but it is suggested that subclasses perform some appropriate
form of error logging. The VM crash dump is one such facility (it doesn't cause a crash and
can be used for generating a VM walkback to the crash dump file at any time)"
| stderrBad |
stderrBad := false.
[ | target |
target := self stderr.
target
next: 40 put: $-;
nextPutAll: 'Unhandled exception - '.
anException printTraceOn: target.
target next: 40 put: $-; cr; cr
] on: Error do: [:e | stderrBad := true].
"If we were unable to write to stderr for some reason, then produce a crash dump"
(stderrBad
or: [false]) "Enable this to record a detailed stack trace for every error that occurs (not just crashes)"
"Note that all the above streams should be in text/translating mode"!
startUI
"Start up the input loop/message loop (instruct InputState appropriate depending on whether
this is a GUI or console session)."
self inputState consoleStartup!
unhandledException: anException
"Private - The unhandled Exception, anException, occurred in the active Process.
Depending on the user response and the resumability of the exception, either
resume or terminate the process.
Note: The exception response protocol (#resume, #pass, #outer, #exit, etc)
can only be sent to an Exception inside a handler block (i.e. the second
argument to BlockClosure>>on:do:)."
self logError: anException.
"Note that unlike a GUI session (which is event driven), we kill the entire session in the event
of an unhandled Error. If you are writing a multi-threaded, headless, server then you may
want to override this behaviour to just #terminate the faulting <Process>."
anException isUserResumable ifFalse: [
self quit: -1].
^anException! !
GUISessionManager comment:
'GUISessionManager is the class of <SessionManager>s used to manage the life-cycle of a graphical (as opposed to command line, or console) application.
Note that Dolphin GUI applications can access the console and standard I/O streams, but a separate console window will be opened.
Instance Variables:
savedWindows <UndefinedObject>, or <Array> of <ViewState>. Saved state of open windows (image save/load)
'!
!GUISessionManager class methodsFor!
icon
"Answers an Icon that can be used to represent this class"
^Icon window!
isConsoleApplication
"Answer whether the sessions managed by instances of the receiver are for a console application
(as opposed to a GUI application, which is a completely separate thing under Windows)."
^false! !
!GUISessionManager methodsFor!
basicShutdown
"Private - Perform basic system shutdown operations, just prior to the VM putting
special isEmpty ifFalse: [verString := verString, ' ', special].
^verString! !
RuntimeSessionManager comment:
'RuntimeSessionManager is the class of <SessionManager>s used to manage the life-cycle of a deployed graphical application.
The main entry point hook is the #main method, and typically one opens one''s main application window there, processing any command line arguments held in the receiver''s ''argv'' instance variable. See one of the samples such as Notepad for an example.
'!
!RuntimeSessionManager class methodsFor!
deploy: fileName
"Create an application image with a new instance of this class installed as
its <RuntimeSessionManager>. For example:
HelloWorldSessionManager deploy: 'HelloWorld'
or
RegEditSessionManager deploy: 'DRegEdit'
The image can be run by Dolphin.exe (e.g. by double-clicking the .img file).
Note that because the application is started by Dolphin.exe the first command
line argument will be the image path.
N.B. The resulting image is for personal use only as it will include all the
development system classes, which must NOT be shipped to third parties.
Dolphin Professional has the ability to create true executable (.EXE) applications
which are of a minimal size (<500Kb for Hello World) that can be legally
shipped to third parties. Dolphin Pro can also create console (command line)
"Answer the class of the application's main window (a <Shell> presenter)."
^self class mainShellClass! !
CalculatorSessionManager comment:
''!
!CalculatorSessionManager class methodsFor!
mainShellClass
"Answer the class of the application's main window (a <Shell> presenter)."
^Calculator! !
!CalculatorSessionManager methodsFor!
main
"Start up the Dolphin Calculator sample application"
self mainShellClass show! !
HelloWorldSessionManager comment:
'A session manager to illustrate how to start an application within #tertiaryStartup processing. This is part of the Application Deployment Kit tutorial.'!
!HelloWorldSessionManager class methodsFor!
mainShellClass
"Answer the class of the application's main window (a <Shell> presenter)."
^HelloWorld! !
!HelloWorldSessionManager methodsFor!
main
"Start up the Hello World application"
self mainShellClass new
show position: 0@0! !
NotepadSessionManager comment:
''!
!NotepadSessionManager class methodsFor!
mainShellClass
"Answer the class of the application's main window (a <Shell> presenter)."
